求助大家解决行列变换的问题

trcookie · 发表于 2024-8-9 00:30

我有n多个二维的数据表，怎么用VBa程序代码转换成一维的面板数据，一维和二维表进行互换，求助大佬，谢谢！

3190496160 · 发表于 2024-8-9 09:50

Sub 转换()
Dim ar As Variant
Dim br()
r = Cells(Rows.Count, 1).End(xlUp).Row
If r < 5 Then MsgBox "数据源为空！": End
ar = Range("a4:k" & r)
ReDim br(1 To 100000, 1 To 3)
For i = 2 To UBound(ar)
If ar(i, 1) <> "" Then
      For j = 2 To UBound(ar, 2)
         If ar(i, j) <> "" Then
            n = n + 1
            br(n, 1) = ar(i, 1)
            br(n, 2) = ar(1, j)
            br(n, 3) = ar(i, j)
         End If
      Next j
End If
Next i
rs = Cells(Rows.Count, 16).End(xlUp).Row
If rs > 4 Then Range("p5:r" & rs) = Empty
[p5].Resize(n, 3) = br
MsgBox "ok!"
End Sub

3190496160 · 发表于 2024-8-9 09:50

分省年度数据地区生产总值.rar (24.39 KB, 下载次数: 3)

trcookie · 发表于 2024-8-11 12:43

3190496160 发表于 2024-8-9 09:50

超级好用，感谢，另外能不能从一维表变回二维表呢？

3190496160 · 发表于 2024-8-12 10:43

Sub 一维转二维()
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Dim ar As Variant
Dim br()
r = Cells(Rows.Count, 16).End(xlUp).Row
If r < 5 Then MsgBox "数据源为空！": End
ar = Range("p4:r" & r)
For i = 2 To UBound(ar)
If ar(i, 2) <> "" Then
      dc(ar(i, 2)) = ""
End If
Next i
ReDim br(1 To UBound(ar), 1 To dc.Count + 1)
k = 1: y = 1
br(1, 1) = "地区"
For i = 2 To UBound(ar)
If ar(i, 1) <> "" And ar(i, 2) <> "" Then
      t = d(ar(i, 1))
      If t = "" Then
         k = k + 1
         d(ar(i, 1)) = k
         t = k
         br(k, 1) = ar(i, 1)
      End If
      lh = d(ar(i, 2))
      If lh = "" Then
         y = y + 1
         d(ar(i, 2)) = y
         lh = y
         br(1, y) = ar(i, 2)
      End If
      br(t, lh) = ar(i, 3)
End If
Next i
[a1].CurrentRegion.Offset(3) = Empty
[a4].Resize(k, y) = br
MsgBox "ok!"
End Sub

3190496160 · 发表于 2024-8-12 10:45

一维转二维，字典的基本用法而已

分省年度数据地区生产总值.rar (27.53 KB, 下载次数: 2)

		自动登录	找回密码
密码			免费注册