[已解决]上万个单元格排一列和排一行

love586

B3=合并（A!D4:A!GN300)
B4=向下拆分（拆分宏已有了）
C2=合并（A!D4:A!GN300)
D2=向右拆分（拆分宏已有了）

重点就是下面两个结果，像sheet（“A”）的B4列和D2行那样排列

直接从sheet（“A”）的（D4:GN300)的内容排在B4列  （竖着排列非空值）
直接从sheet（“A”）的（D4:GN300)的内容排在sheet（“C”）D2横行（横着排列非空值）
排序拆分1.rar (259.93 KB, 下载次数: 3)

2021-11-23 23:36 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

心正意诚身修

2021-11-24 08:55

1. Sub 数据转置()
   
2. Dim data, arr(), i As Integer, j As Integer, k As Single
   
3. data = Sheets("A").Range("d4:gn300").Value
   
4. ReDim arr(1 To 16370)
   
5. For i = 1 To UBound(data)
   
6.     For j = 1 To UBound(data, 2)
   
7.         If data(i, j) <> "" Then
   
8.             k = k + 1
   
9.             arr(k) =data(i, j)
   
10.         End If
    
11.     Next
    
12. Next
    
13. Sheets("C").Range("d2").Resize(1, k) = arr
    
14. Sheets("C").Range("b4").Resize(k, 1) = Application.Transpose(arr)
    
15. End Sub
    

复制代码

跳转到最佳答案楼层

心正意诚身修

1. Sub 数据转置()
   
2. Dim data, arr(), i As Integer, j As Integer, k As Single
   
3. data = Sheets("A").Range("d4:gn300").Value
   
4. ReDim arr(1 To 16370)
   
5. For i = 1 To UBound(data)
   
6.     For j = 1 To UBound(data, 2)
   
7.         If data(i, j) <> "" Then
   
8.             k = k + 1
   
9.             arr(k) =data(i, j)
   
10.         End If
    
11.     Next
    
12. Next
    
13. Sheets("C").Range("d2").Resize(1, k) = arr
    
14. Sheets("C").Range("b4").Resize(k, 1) = Application.Transpose(arr)
    
15. End Sub
    

复制代码

love586

心正意诚身修 发表于 2021-11-24 08:55

谢谢大佬了，