我正在努力創建一個 VBA 宏，它根據標題組合列的資料。
示例： 示例
輸出應該是： 輸出（Lemon Values UIOP - 截圖錯誤）
另外我這個資料表沒有固定的范圍，這讓我很頭疼:)
希望有人可以在這里幫助我！
這是我目前擁有的：
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
uj5u.com熱心網友回復：
使用嵌套字典以獲得唯一性。
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/417849.html
標籤：
下一篇：使用宏將公式應用于單元格中的值