Excel VBA基于标题组合列

Question

我正在构建一个VBA宏，该宏基于标头组合列的数据。

示例：示例

输出应为：输出(Lemon值U I O P-屏幕截图中错误(

此外，我没有这个数据表的固定范围，这让我头疼：(

希望有人能在这里帮我！

这就是我目前拥有的：

With wb.Sheets("Sheet1").UsedRange
For C = 2 To .Columns.Count
P = Application.Match(.Cells(C), .Rows(1), 0)
If P < C Then
Range(.Cells(2, C), .Cells(C).End(xlDown)).Copy .Cells(P).End(xlDown)(2)
S = IIf(S > "", S & ",", "") & .Cells(C).Address(0, 0)
End If
Next
End With
If S > "" Then Range(S).EntireColumn.Delete

Answer 1

使用嵌套字典以获得唯一性。

Option Explicit
Sub Macro1()
Dim wb As Workbook, wsIn As Worksheet, wsOut As Worksheet
Dim ar, dict As Object, k, val
Dim i As Long, j As Long, hdr As String

Set dict = CreateObject("Scripting.Dictionary")
Set wb = ThisWorkbook

' input data into array
Set wsIn = wb.Sheets("Sheet1")
ar = wsIn.UsedRange

' scan array elements into dict/collection
For j = 1 To UBound(ar, 2)
hdr = Trim(ar(1, j))
For i = 2 To UBound(ar)
If Not dict.exists(hdr) Then
dict.Add hdr, CreateObject("Scripting.Dictionary")
End If

val = ar(i, j)
If Len(val) > 0 Then
dict(hdr)(val) = 1 ' add to keys
End If
Next
Next

' output
i = 0
j = 0
Set wsOut = wb.Sheets("Sheet2")
With wsOut
For Each k In dict
j = j + 1
i = 1
.Cells(i, j) = k
For Each val In dict(k)
i = i + 1
.Cells(i, j) = val
Next
Next
End With
End Sub