【VBA方式】EXCEL转置-交叉型转竖排

yangkd · 发表于 2011-10-28 11:48

本帖最后由 yangkd 于 2011-10-28 11:49 编辑

由于工作需要，需把交叉表格式转化为常见的格式：如图。谢谢！
EXCEL转置-交叉型转竖排.jpg

EXCEL转置-交叉型转竖排.rar (11.38 KB, 下载次数: 56)

gdfcx · 发表于 2011-10-28 12:01

Sub macro()
Dim arr, brr(1 To 10000, 2), k&, i&, j%
arr = Sheets(3).[a1].CurrentRegion
For i = 2 To UBound(arr)
For j = 2 To UBound(arr, 2)
If arr(i, j) <> "" Then
k = k + 1
brr(k, 0) = arr(i, 1)
brr(k, 1) = arr(1, j)
brr(k, 2) = arr(i, j)
End If
Next j
Next i
Sheets(2).[a1:c1] = [{"品番","交期","订单未纳数"}]
Sheets(2).[a2].Resize(UBound(brr), 3) = brr
Sheets(2).Select
End Sub

复制代码

raohongying · 发表于 2011-10-28 12:11

数组，搞得很好

yangkd · 发表于 2011-10-28 12:20

gdfcx 发表于 2011-10-28 12:01

谢谢老师，效果很好！

yangkd · 发表于 2011-10-28 12:21

raohongying 发表于 2011-10-28 12:11
数组，搞得很好

请给个公式和附件，谢谢！！

zyjaty · 发表于 2013-2-7 10:41

无意中查到这个，正好对我的工作太有用了，非常感谢gdfcx。

LMY123 · 发表于 2018-7-25 11:20

交叉表转二维表

chengshanming · 发表于 2018-7-26 12:38

不错！如果要反过来呢，代码如何写？由三列变成横向的N列

guski216 · 发表于 2018-8-7 15:28

gdfcx 发表于 2011-10-28 12:01

大侠，无意看到你这注代码，对我很有帮助，我想问个问题，如果反过来写，就是说把转置的结果变成交叉表那种结果，能不能帮写段代码，万分感谢

任飘渺 · 发表于 2018-8-7 16:10

Sub tt()
Dim i  As Integer, arr, brr()
arr = Sheet3.Range("a1").CurrentRegion
ReDim brr(1 To UBound(arr) * UBound(arr, 2), 1 To 3)
brr(1, 1) = "品番": brr(1, 2) = "交期": brr(1, 3) = "订单未纳数"
n = 2
For i = 2 To UBound(arr)
      For j = 2 To UBound(arr, 2)
         If arr(i, j) <> "" Then
            brr(n, 1) = arr(i, 1)
            brr(n, 2) = arr(1, j)
            brr(n, 3) = arr(i, j)
            n = n + 1
         End If
         Next j
Next i
Sheet1.Range("a1").Resize(n, 3) = brr
End Sub

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

[求助] 【VBA方式】EXCEL转置-交叉型转竖排