怎么处理单元格内被空格分开的内容到新行

西北风真好喝

求大神帮我看看，怎么处理单元格内被空格分开的内容到新的行。

shiruiqiang

shiruiqiang

Sub test()
Dim arr, brr(1 To 1000, 1 To 2)
Sheets(1).Range("g1:h1000").ClearContents
arr = Sheets(1).[b1].CurrentRegion
For x = 1 To UBound(arr)
If Len(arr(x, 1)) = 0 Then
n = n + 1
brr(n, 1) = arr(x, 1)
brr(n, 2) = arr(x, 2)
Else
  ar = Split(arr(x, 1))
  For i = 0 To UBound(ar)
  If Len(ar(i)) > 0 Then
  n = n + 1
  brr(n, 1) = ar(i)
  brr(n, 2) = arr(x, 2)
  End If
  Next
End If
Next

Sheets(1).[g1].Resize(n, 2) = brr

End Sub

lcluck2002

准提部林

Sub TEST_A1()
Dim Arr, Brr, N&, A, i&, j%, k%
Arr = Range([a1], [b65536].End(3))
ReDim Brr(1 To UBound(Arr) * 10, 1 To 2)
For i = 1 To UBound(Arr)
    For Each A In Split(Trim(Arr(i, 1)) & " ", " ")
        If k <> i Or A <> "" Then
           N = N + 1: k = i
           Brr(N, 1) = A: Brr(N, 2) = Arr(i, 2)
        End If
    Next A
Next i
[g:h].ClearContents
[g1].Resize(N, 2) = Brr
End Sub

准提部林

審核中...上圖//

yylucke

准提部林 发表于 2023-4-2 11:21
審核中...上圖//

循环很巧妙，学习了！

西北风真好喝

shiruiqiang 发表于 2023-4-2 09:57
Sub test()
Dim arr, brr(1 To 1000, 1 To 2)
Sheets(1).Range("g1:h1000").ClearContents

感谢，试了下，非常实用。

西北风真好喝

准提部林 发表于 2023-4-2 11:21
審核中...上圖//

大神就是大神，感谢感谢

gwjkkkkk

参与一下。。。