我正在使用一個資料集，該資料集包含許多列，但并非所有列都具有關聯值。我已經能夠找到一些 VBA 代碼來取消透視每一行的資料并捕獲固定欄位。但是，列的標題包含有關關聯值的特定資訊。我需要幫助來回傳標識值的每個欄位的列頭值。
我的資料集
所需的輸出（僅缺少標題/“帳戶”值
我正在使用的當前 VBA
Sub Tester()
Dim p
'get the unpivoted data as a 2-D array
p = UnPivotData(Sheets("Sheet1").Range("A1").CurrentRegion, _
6, False, False)
With Sheets("Sheet2").Range("A1")
.CurrentRegion.ClearContents
.Resize(UBound(p, 1), UBound(p, 2)).Value = p 'populate array to sheet
End With
End Sub
Function UnPivotData(rngSrc As Range, fixedCols As Long, _
Optional AddCategoryColumn As Boolean = True, _
Optional IncludeBlanks As Boolean = True)
Dim nR As Long, nC As Long, data, dOut()
Dim r As Long, c As Long, rOut As Long, cOut As Long, cat As Long
Dim outRows As Long, outCols As Long
data = rngSrc.Value 'get the whole table as a 2-D array
nR = UBound(data, 1) 'how many rows
nC = UBound(data, 2) 'how many cols
'calculate the size of the final unpivoted table
outRows = nR * (nC - fixedCols)
outCols = fixedCols IIf(AddCategoryColumn, 2, 1)
'resize the output array
ReDim dOut(1 To outRows, 1 To outCols)
'populate the header row
For c = 1 To fixedCols
dOut(1, c) = data(1, c)
Next c
If AddCategoryColumn Then
dOut(1, fixedCols 1) = "Category"
dOut(1, fixedCols 2) = "Value"
Else
dOut(1, fixedCols 1) = "Value"
End If
'populate the data
rOut = 1
For r = 2 To nR
For cat = fixedCols 1 To nC
If IncludeBlanks Or Len(data(r, cat)) > 0 Then
rOut = rOut 1
'Fixed columns...
For c = 1 To fixedCols
dOut(rOut, c) = data(r, c)
Next c
'populate unpivoted values
If AddCategoryColumn Then
dOut(rOut, fixedCols 1) = data(1, cat)
dOut(rOut, fixedCols 2) = data(r, cat)
Else
dOut(rOut, fixedCols 1) = data(r, cat)
End If
End If
Next cat
Next r
UnPivotData = dOut
End Function
uj5u.com熱心網友回復：
UnPivotData有一個AddCategoryColumn您要傳遞的引數False- 如果您改為傳遞True，那么您將得到您想要的結果。
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/433511.html