[已解决]宏代码：散状分布的数据如何归集成一列

lijian8003

例如：单元格内有多个数据，且存在重复项，散布于a1:c13区域，欲用宏代码将其归集到F列（不删重复数据）。

实际运用时数据庞大，非常注重宏代码的运行速度。


感谢 鄂龙蒙 老师鼎力相助

最佳答案

月排行榜 / 总排行榜

sam-wang

2022-5-20 10:33

執行0.015秒如圖片，請測試看看，謝謝

Sub test()
Dim Arr, Brr(1 To 10000, 1 To 1), a, R&, n&, i&, j&
Tm = Timer
R = Columns("A:C").Find("*", , , , , 2).Row
Arr = Range("a1:c" & R)
For j = 1 To UBound(Arr, 2): For i = 1 To UBound(Arr)
    a = Split(Arr(i, j), " ")
    For k = 0 To UBound(a)
        n = n + 1: Brr(n, 1) = a(k)
    Next
Next i: Next j
Range("e1").Resize(n, 1).NumberFormatLocal = "@"
Range("e1").Resize(n, 1) = Brr
MsgBox Timer - Tm
End Sub

跳转到最佳答案楼层

sam-wang

執行0.015秒如圖片，請測試看看，謝謝

Sub test()
Dim Arr, Brr(1 To 10000, 1 To 1), a, R&, n&, i&, j&
Tm = Timer
R = Columns("A:C").Find("*", , , , , 2).Row
Arr = Range("a1:c" & R)
For j = 1 To UBound(Arr, 2): For i = 1 To UBound(Arr)
    a = Split(Arr(i, j), " ")
    For k = 0 To UBound(a)
        n = n + 1: Brr(n, 1) = a(k)
    Next
Next i: Next j
Range("e1").Resize(n, 1).NumberFormatLocal = "@"
Range("e1").Resize(n, 1) = Brr
MsgBox Timer - Tm
End Sub

lijian8003

sam-wang 发表于 2022-5-20 10:33
執行0.015秒如圖片，請測試看看，謝謝

Sub test()

感谢，太棒了！

lijian8003

sam-wang 发表于 2022-5-20 10:33
執行0.015秒如圖片，請測試看看，謝謝

Sub test()

老师，您好！宏代码循序3次，分别写入E F G列，
出现E列数据并入F列、F列数据并入G列现象，
如何才能实现前次循环结果不并入后次循环？

sam-wang

lijian8003 发表于 2022-5-20 17:05
老师，您好！宏代码循序3次，分别写入E F G列，
出现E列数据并入F列、F列数据并入G列现象，
如何才能实 ...

Sub test()
Dim Arr, Brr(1 To 10000, 1 To 1), a, R&, n&, i&, j&, C%
Tm = Timer
R = Columns("A:C").Find("*", , , , , 2).Row
Arr = Range("a1:c" & R)
For j = 1 To UBound(Arr, 2): For i = 1 To UBound(Arr)
    a = Split(Arr(i, j), " ")
    For k = 0 To UBound(a)
        n = n + 1: Brr(n, 1) = a(k)
    Next
Next i: Next j
R = 1
For C = 1 To 3
    Cells(R, C + 4).Resize(n, 1).NumberFormatLocal = "@"
    Cells(R, C + 4).Resize(n, 1) = Brr
    R = R + n
Next
MsgBox Timer - Tm
End Sub

lijian8003

sam-wang 发表于 2022-5-21 06:55
Sub test()
Dim Arr, Brr(1 To 10000, 1 To 1), a, R&, n&, i&, j&, C%
Tm = Timer

感谢