VBA-行-＞列

Sub 行转列()
Dim dic As Object, i As Long, arr, K, T
Set dic = CreateObject("Scripting.Dictionary")

arr = Worksheets("源数据").[A1].CurrentRegion
Worksheets("结果").Cells.Clear
ReDim BRR(1 To UBound(arr), 1 To 3) '声明从2到N行，1到2列，如要添加输出字段请修改1 TO 5
 For i = 2 To UBound(arr)
    If Not dic.ExiSts(arr(i, 2)) Then
    K = K + 1
    
     dic(arr(i, 2)) = K '字典标记行
     BRR(K, 1) = arr(i, 2)  '将数据写入数组BRR，将现有的数据赋给BRR，将1列CELL赋值
     BRR(K, 2) = BRR(K, 2) & "|" & arr(i, 5)
     BRR(K, 3) = BRR(K, 3) & "|" & arr(i, 6)
     
     
    Else
      R = dic(arr(i, 2)) '读取标记行
      N = N + 1
      BRR(R, 2) = BRR(R, 2) & "|" & arr(i, 5)
      BRR(R, 3) = BRR(R, 3) & "|" & arr(i, 6)
      
      
      'BRR(R, 4) = R
    End If
  Next
  Worksheets("结果").[A2].Resize(K, 4) = BRR  'K行与4列
  Worksheets("结果").Range("A1:D1") = Array("CELL", "功率", "RRU")
End Sub