难度1 二维转一维

x-xx-xx

20231116_174703.rar (165.65 KB, 下载次数: 54)

2023-11-16 18:00 上传

点击文件名下载附件

1. Sub Macro1()
   
2.    
   
3.     Dim 编号01_数组
   
4.     Dim 编号02_行数
   
5.     Dim 编号03_列数
   
6.     Dim 编号04_数组()
   
7.     Dim 编号05_行数
   
8.     Dim 编号06_列数
   
9.     Dim 编号07_第几行
   
10.     Dim 编号08_第几列
    
11.     Dim 编号09_第几行
    
12.    
    
13.     编号01_数组 = Range("A1:I11").Value
    
14.     编号02_行数 = UBound(编号01_数组, 1)
    
15.     编号03_列数 = UBound(编号01_数组, 2)
    
16.    
    
17.     编号05_行数 = (编号02_行数 - 1) * (编号03_列数 - 1)
    
18.     编号06_列数 = 3
    
19.     Erase 编号04_数组
    
20.     ReDim Preserve 编号04_数组(1 To 编号05_行数, 1 To 编号06_列数)
    
21.    
    
22.     编号09_第几行 = 0
    
23.     For 编号07_第几行 = 2 To UBound(编号01_数组, 1) Step 1
    
24.         
    
25.         For 编号08_第几列 = 2 To UBound(编号01_数组, 2) Step 1
    
26.             
    
27.             编号09_第几行 = 编号09_第几行 + 1
    
28.             
    
29.             编号04_数组(编号09_第几行, 1) = 编号01_数组(编号07_第几行, 编号08_第几列)
    
30.             编号04_数组(编号09_第几行, 2) = 编号01_数组(1, 编号08_第几列)
    
31.             编号04_数组(编号09_第几行, 3) = 编号01_数组(编号07_第几行, 1)
    
32.         
    
33.         Next
    
34.         
    
35.     Next
    
36. 
    
37.     Range("O2").Resize(UBound(编号04_数组, 1), UBound(编号04_数组, 2)) = 编号04_数组
    
38. 
    
39. End Sub

复制代码

cjc209

循环就搞定了  超级简单

明天会更好zj

pq里面，逆透视，一键搞定，没有任何难度。

280022976

啥情况，打开就报毒。

680926

Sub t()
Dim arr, brr()
Dim i As Integer
Dim j As Integer, k
Dim d As Object
Set d = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion
For i = 2 To UBound(arr)
    For j = 2 To UBound(arr, 2)
        k = k + 1
        ReDim Preserve brr(1 To 3, 1 To k)
        brr(1, k) = arr(i, j)
        brr(2, k) = arr(1, j)
        brr(3, k) = arr(i, 1)
    Next
Next
[p1].Resize(1, 3) = Array("姓名", "班级", "等级")
[p2].Resize(k, 3) = Application.Transpose(brr)
End Sub

xf小云

caiyu93

今铭昔

szqhb

非常感谢，我提的提问，你在这里单独开贴分享了，并展开了讨论，实现方法多种多样，殊途同归。多谢各位！

咔咔乱坠

参与一下，365函数

1. =TEXT({1,-1,0}%,TOCOL(B2:I11&";"&B1:I1&";"&A2:A11,,2))

复制代码