二维表转一维表

nxxhswl

使用VBA命令将二维表戴的为一维表，请教高手。

飞天篮球猪

仅供参考

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, cr, i&, j&, r&
   
    Application.ScreenUpdating = False
   
    ar = Sheets(1).[B1].CurrentRegion.Value
    ReDim br(1 To UBound(ar) * UBound(ar, 2), 1 To 4)
    cr = Split("日期 车牌号 项目 金额")
    r = r + 1
    For j = 0 To UBound(cr)
        
        br(r, j + 1) = cr(j)
    Next j
    For j = 3 To UBound(ar, 2) - 1
        For i = 2 To UBound(ar)
            If Len(ar(i, j)) Then
                r = r + 1
                br(r, 1) = ar(i, 1)
                br(r, 2) = ar(i, 2)
                br(r, 3) = ar(1, j)
                br(r, 4) = ar(i, j)
            End If
        Next i
    Next j
   
    Cells.Clear
    With [B1].Resize(r, UBound(br, 2))
        .Value = br
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
    End With
   
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

ykcbf1100

参与一下。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.1
   
2.     With Sheets("2-支出项")
   
3.         r = .Cells(Rows.Count, 3).End(3).Row
   
4.         arr = .Range("a1:m" & r)
   
5.     End With
   
6.     ReDim brr(1 To UBound(arr), 1 To 6)
   
7.     b = [{4,7,5,6}]
   
8.     On Error Resume Next
   
9.     For j = 1 To UBound(b)
   
10.         For i = 2 To UBound(arr)
    
11.             s = arr(i, 3)
    
12.             If s <> Empty And arr(i, b(j)) <> Empty Then
    
13.                 m = m + 1
    
14.                 brr(m, 2) = s
    
15.                 brr(m, 3) = arr(1, b(j))
    
16.                 brr(m, 4) = arr(i, b(j))
    
17.             End If
    
18.         Next
    
19.     Next
    
20.     With Sheets("需求")
    
21.         .UsedRange.Offset(1) = ""
    
22.         If m > 0 Then .[b2].Resize(m, 6) = brr
    
23.     End With
    
24. End Sub
    
25. 
    

复制代码

明天会更好zj

power query就选中列，点下菜单栏的逆透视其它列，瞬间搞定！

Enocheasty

本来以前也打算做什么数据表一维转二维，二维转一维的，但是在Excel自带的数据透视功能面前都不够看的。后来就放弃了。

nxxhswl

gwjkkkkk 发表于 2024-3-1 18:58
参与一下。。。

真不错，连空值都去掉了。

nxxhswl

明天会更好zj 发表于 2024-3-1 19:40
power query就选中列，点下菜单栏的逆透视其它列，瞬间搞定！

power query容易出现卡顿，就没有学。