我正在尋找小幫助。我在四列中有序列號、警報、計數和組基數的資料我想將資料格式從垂直更改為水平，如下面的使用 vba 的螢屏截圖。我已經撰寫了一些代碼來從輸入作業表中讀取資料并放入Scripting.Dictionary. 但我不知道如何以列的水平格式顯示。
輸入資料 ：
預期輸出：
源代碼：
Sub ConsecutiveHorizontal()
Dim wsData As Worksheet, wsOut As Worksheet
Dim dictSerNo As Object, dictAlert As Object, distAlertGroup
Dim arData, arOut, k, rngOut As Range
Dim lastrow As Long, i As Long
Dim serNo As String, alert As String, alertGroup As String
Dim r As Long, c As Long, t0 As Single: t0 = Timer
Set dictSerNo = CreateObject("Scripting.Dictionary")
Set dictAlert = CreateObject("Scripting.Dictionary")
Set distAlertGroup = CreateObject("Scripting.Dictionary")
On Error Resume Next
Application.DisplayAlerts = False
Sheets("ConsecutiveOverview").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Sheets.Add.Name = "OutputData"
Set wsOut = Sheets("OutputData")
Set wsData = Sheets("InputData")
r = 1: c = 1
With wsData
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 'Device Serial Number
arData = .Range("A1:D" & lastrow).Value2
' get unique serno and alert
For i = 2 To lastrow
serNo = arData(i, 1) '50502154, 50502180 etc,
alert = arData(i, 2) '9501 , 9301, 4142 etc
alertGroup = arData(i, 4) ' 1 To 3, 4 To 8, 9
If dictSerNo.Exists(serNo) Then
ElseIf Len(serNo) > 0 Then
r = r 1
dictSerNo.Add serNo, r
End If
If dictAlert.Exists(alert) Then
ElseIf Len(alert) > 0 Then
c = c 1
dictAlert.Add alert, c
distAlertGroup.Add alert, alertGroup
End If
Next
End With
' add headers
arOut(1, 1) = "Serial No"
' sernos and alerts
For Each k In dictSerNo
arOut(dictSerNo(k), 1) = k
Next
For Each k In dictAlert
arOut(1, dictAlert(k)) = k
Next
End Sub
uj5u.com熱心網友回復：
這里有一些更通用的東西（對于使用不太具體的旋轉方法很有用）：
Sub ConsecutiveHorizontal()
Const ROW_KEY_IDX As Long = 1
Const COL_KEY_IDX As Long = 2
Const VAL_KEY_IDX As Long = 4
Dim wsData As Worksheet, wsOut As Worksheet, wb As Workbook
Dim dictRow As Object, dictCol As Object
Dim arData, arOut, i As Long, t0 As Single
t0 = Timer
Set wb = ThisWorkbook
On Error Resume Next
Application.DisplayAlerts = False
wb.Sheets("OutputData").Delete '?
Application.DisplayAlerts = True
On Error GoTo 0
Set wsData = wb.Sheets("InputData")
Set wsOut = wb.Sheets.Add() 'get reference directly
wsOut.Name = "OutputData"
With wsData
arData = .Range("A2:D" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value2
End With
'get unique column values and indexes
Set dictRow = ArrayColumnUniques(arData, ROW_KEY_IDX)
Set dictCol = ArrayColumnUniques(arData, COL_KEY_IDX)
ReDim arOut(1 To dictRow.Count 1, 1 To dictCol.Count 1) 'resize output array
arOut(1, 1) = "Serial No"
'populate output array row and column headers
For i = 1 To dictRow.Count
arOut(i 1, 1) = dictRow.keys()(i - 1)
Next i
For i = 1 To dictCol.Count
arOut(1, i 1) = dictCol.keys()(i - 1)
Next i
'populate output values - assumes only one value per unique row/column key combination
For i = 1 To UBound(arData)
arOut(dictRow(arData(i, ROW_KEY_IDX)) 1, _
dictCol(arData(i, COL_KEY_IDX)) 1) = arData(i, VAL_KEY_IDX)
Next i
With wsOut.Range("B2")
.Resize(UBound(arOut, 1), UBound(arOut, 2)).Value = arOut
End With
End Sub
'return a dictionary with all unique values from array column `colIndex`
Function ArrayColumnUniques(arr As Variant, colIndex As Long) As Object
Dim r As Long, i As Long, dict As Object, v
Set dict = CreateObject("scripting.dictionary")
dict.comparemode = 1 'vbTextCompare
i = 0
For r = LBound(arr, 1) To UBound(arr, 1)
v = arr(r, colIndex)
If Len(v) > 0 Then
If Not dict.exists(v) Then
i = i 1
dict.Add v, i
End If
End If
Next r
Set ArrayColumnUniques = dict
End Function
uj5u.com熱心網友回復：
如果您有 Power Query，在 Windows Excel 2010 和 Office/Excel 365 中可用，您可以通過兩個步驟完成此操作：
- 洗掉
Consecutive Count列 Alert Code帶有 Value =Consecutive Group且沒有聚合的Pivot ：
一切都可以通過 UI
M 代碼實作
let
//change table name in next line to actual name in your worksheet
Source = Excel.CurrentWorkbook(){[Name="Table5"]}[Content],
//set the data types
#"Changed Type" = Table.TransformColumnTypes(Source,{
{"Serial Number", Int64.Type},
{"Alert Code", Int64.Type},
{"Consecutive Count", Int64.Type},
{"Consecutive Group", type text}}),
//Remove the Consecutive Count column
#"Removed Columns" = Table.RemoveColumns(#"Changed Type",{"Consecutive Count"}),
//Pivot Alert Code
#"Pivoted Column" = Table.Pivot(
Table.TransformColumnTypes(#"Removed Columns", {{"Alert Code", type text}}, "en-US"),
List.Distinct(Table.TransformColumnTypes(#"Removed Columns", {{"Alert Code", type text}}, "en-US")[#"Alert Code"]),
"Alert Code", "Consecutive Group")
in
#"Pivoted Column"
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/406287.html
標籤：