用VBA和函数想解决一个电子表格转置的问题

摄狼一线天

想解决一个电子表格转置的问题

把“2024秋课后服务兴趣小组.xlsx” 电子表格的“计算机报名表”工作表转置成“调查表”效果。

loirol

清风竹-

请看附件。

ykcbf1100

每班目前只取3人

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.11.13
   
2.     arr = Sheets("计算机报名表").UsedRange
   
3.     ReDim brr(1 To 10000, 1 To 3)
   
4.     For i = 3 To UBound(arr)
   
5.         For j = 2 To 4
   
6.             If arr(i, j) <> Empty Then
   
7.                 m = m + 1
   
8.                 brr(m, 1) = m
   
9.                 brr(m, 2) = arr(i, j)
   
10.                 brr(m, 3) = arr(i, 1)
    
11.             End If
    
12.         Next
    
13.     Next
    
14.     With Sheets("调查表")
    
15.         .UsedRange.Offset(2).ClearContents
    
16.         .[a3].Resize(m, 3) = brr
    
17.         .[a3].Resize(m, 3).Borders.LineStyle = 1
    
18.     End With
    
19.     MsgBox "OK！"
    
20. End Sub
    

复制代码

摄狼一线天

loirol 发表于 2024-11-13 13:47

谢谢老师的代码

摄狼一线天

ykcbf1100 发表于 2024-11-13 14:03
参与一下。。。

谢谢老师的帮助，真的谢谢。

摄狼一线天

清风竹- 发表于 2024-11-13 14:00
请看附件。

谢谢老师的帮助，感谢感谢

szqhb

ykcbf1100 发表于 2024-11-13 14:02
每班目前只取3人

经测试，不是只取3名，而是全部