将 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
我现在破例,假设你不知道社区规则,但我们这里不提供免费的代码编写服务。提交其他问题时,请阅读规则并完全遵守。
测试后发送一些反馈。如果有什么不清楚的地方,请不要犹豫,要求澄清。我们的主要目标是让人们学习。
我有一个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
我现在破例,假设你不知道社区规则,但我们这里不提供免费的代码编写服务。提交其他问题时,请阅读规则并完全遵守。
测试后发送一些反馈。如果有什么不清楚的地方,请不要犹豫,要求澄清。我们的主要目标是让人们学习。