将 3 列的行拆分为 2 列的两行

Split row with 3 columns into two rows with 2 columns

我有一个table,其中一行将被分成两行,每行有不同的列。

Input table

Output table

如您所见,除了 Date 每个 ID 的每一列都保持不变,所以我想获得具有唯一性 ID 的每一行,复制它(所以我有每个 ID) 有 2 行,然后在 3rd column 的一行中,我将有 Interest Rate 值,而在第二行中有 Depreciation 值。

是否可以使用公式或VBA?

请尝试下一个代码。它使用字典,正如我在评论中推荐的那样,然后处理它的 keys/items 以输出 arrFin,立即落入范围“G2”):

Sub UniqueCompact()
  Dim sh As Worksheet, lastRow As Long, arr, arrFin, i As Long, dict As Object
  
  Set sh = ActiveSheet
  lastRow = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row
  arr = sh.Range("A2:E" & lastRow).value 'place the range in an array for faster iteration
  
  Set dict = CreateObject("Scripting.Dictionary")              'set the dictionary
  For i = 1 To UBound(arr)
    dict(arr(i, 1)) = Array(arr(i, 3), arr(i, 4), arr(i, 5))        'fill the dictionary
  Next i
 
  ReDim arrFin(1 To dict.count * 2, 1 To 3) 'redim the final array to kep two rows per a dictionary key
  Dim k As Long: k = 1
  For i = 0 To dict.count - 1
        arrFin(k, 1) = dict.Keys()(i): arrFin(k, 2) = dict.Items()(i)(0): arrFin(k, 3) = dict.Items()(i)(1): k = k + 1
        arrFin(k, 1) = dict.Keys()(i): arrFin(k, 2) = dict.Items()(i)(0): arrFin(k, 3) = dict.Items()(i)(2): k = k + 1
  Next i
  'drop the pocessed array content in G2:
  sh.Range("G2").Resize(UBound(arrFin), UBound(arrFin, 2)).value = arrFin
End Sub

我现在破例,假设你不知道社区规则,但我们这里不提供免费的代码编写服务。提交其他问题时,请阅读规则并完全遵守。

测试后发送一些反馈。如果有什么不清楚的地方,请不要犹豫,要求澄清。我们的主要目标是让人们学习