文本拆分问题，将一列拆分为两列

喝酒的毛毛虫

文本拆分问题，将一列拆分为两列，具体见附件，谢谢。 文本拆分问题.rar (15.67 KB, 下载次数: 26)

2023-2-8 16:10 上传

点击文件名下载附件

ykcbf1100

参与一下。

清风竹-

请看附件。

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     With Worksheets("sheet1")
   
5.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.         arr = .Range("a1:a" & r)
   
7.         ReDim brr(1 To Application.Ceiling(r / 2, 1), 1 To 2)
   
8.         m = 1
   
9.         n = 1
   
10.         For i = 1 To UBound(arr)
    
11.             brr(m, n) = IIf(n = 1, m * 2 - 1, m * 2) & "." & arr(i, 1)
    
12.             m = m + 1
    
13.             If m > UBound(brr) Then
    
14.                 m = 1
    
15.                 n = 2
    
16.             End If
    
17.         Next
    
18.         .Range("b1").Resize(UBound(brr), UBound(brr, 2)) = brr
    
19.     End With
    
20. End Sub
    

复制代码

chxw68

参与一下。

zxsea_7426

中国人的老习惯：凑个热闹

gwjkkkkk

参与一下。。。

准提部林

Sub TEST_A1()
Dim Arr, Brr, i&, j%, k%, N&, s%
Arr = Range([A1], Cells(Rows.Count, 1).End(3))
k = (UBound(Arr) - 1) \ 2 + 1
ReDim Brr(1 To k, 1)
For i = 1 To UBound(Arr)
    N = N + 1: s = s + 2
    Brr(N, j) = s - j - 1 & "." & Arr(i, 1)
    If i = k Then N = 0: s = 2: j = 1
Next i
[b1].Resize(k, 2) = Brr
End Sub

grf1973

1. Sub test1()
   
2.     Dim Rng As Range
   
3.     r = [a65536].End(3).Row: r1 = (r - 1) \ 2 + 1
   
4.     Arr = [a1].Resize(r + 1, 2)
   
5.     For i = 1 To r1
   
6.         Arr(i, 1) = 2 * i - 1 & "." & Arr(i, 1)
   
7.         If Arr(r1 + i, 1) <> "" Then Arr(i, 2) = 2 * i & "." & Arr(r1 + i, 1)
   
8.     Next
   
9.     [d1].Resize(r1, 2) = Arr
   
10. End Sub

复制代码