求修改成将字符或数字分列

sanfuhai

改成将字符或数字分列，详情请看附件，SHEET1和SHEET2 修改代码AA.rar (22.39 KB, 下载次数: 8)

2020-5-13 17:29 上传

点击文件名下载附件

cutecpu

1. Sub demo()
   
2. 
   
3.    With Sheets("Sheet1")
   
4.    Dim arr: arr = Range("AS2").Resize(.Cells(Rows.Count, "AS").End(xlUp).Row - 1, 2)
   
5.    
   
6.    Set dic = CreateObject("Scripting.Dictionary")
   
7.    
   
8.    For i = 1 To UBound(arr): dic(arr(i, 1)) = arr(i, 2): Next
   
9.    
   
10.    For i = 2 To .Cells(Rows.Count, "H").End(xlUp).Row
    
11.       brr = Split(dic(.Cells(i, "H").Value), ",")
    
12.       .Cells(i, "AB").Resize(1, UBound(brr) + 1) = brr
    
13.    Next
    
14.    
    
15.    End With
    
16.    
    
17. End Sub

复制代码

祝順心，南無阿彌陀佛！

金樽空对月

不用字典的方法

1. Sub itest()
   
2. Dim x, y
   
3. Dim ar, br, cr
   
4. With Sheet1
   
5. ar = .Range("h2:h" & .Range("h50000").End(3).Row)
   
6. br = .Range("as2:at" & .Range("as50000").End(3).Row)
   
7. .Range("ab2:ag5000") = ""
   
8. For x = 1 To UBound(ar)
   
9.   For y = 1 To UBound(br)
   
10.     If ar(x, 1) = br(y, 1) Then
    
11.        cr = Split(br(y, 2), ",")
    
12.        .Cells(x + 1, "ab").Resize(1, UBound(cr) + 1) = cr
    
13.        Exit For
    
14.     End If
    
15.   Next
    
16. Next
    
17. End With
    
18. End Sub

复制代码