[已解决]宏代码：单元格内有多数据如何同位取数

lijian8003

X列 AR列各单元格有多位数据       
若AR2=AP1的数据在第四位，则取X2的第四位数据，写入AU2       
若AR3=AP1的数据在第二位，则取X3的第二位数据，写入AU3       
若AR4=AP1的数据在第七位，则取X4的第七位数据，写入AU4       
若AR5没有数据与AP1相同，则AU5为空       
若AR6=AP1的数据在第五位，而X6的第五位没有数据，则AU6为空

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2021-12-1 19:56

1. Sub test()
   
2. Dim s$, arr, arrMa, i&, n&, arrTmp
   
3. s = [ap1]
   
4. arr = Array([ar2].CurrentRegion.Value, [x2].CurrentRegion.Value)
   
5. For i = 1 To UBound(arr(0))
   
6.   arrMa = Split(arr(0)(i, 1), ",")
   
7.   On Error Resume Next
   
8.   arr(1)(i, 1) = Split(arr(1)(i, 1), ",")(Application.Match(s, arrMa, 0) - 1)
   
9.   If Err Then arr(1)(i, 1) = ""
   
10.   On Error GoTo 0
    
11. Next
    
12. [au2].Resize(UBound(arr(0))) = arr(1)
    
13. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

1. Sub test()
   
2. Dim s$, arr, arrMa, i&, n&, arrTmp
   
3. s = [ap1]
   
4. arr = Array([ar2].CurrentRegion.Value, [x2].CurrentRegion.Value)
   
5. For i = 1 To UBound(arr(0))
   
6.   arrMa = Split(arr(0)(i, 1), ",")
   
7.   On Error Resume Next
   
8.   arr(1)(i, 1) = Split(arr(1)(i, 1), ",")(Application.Match(s, arrMa, 0) - 1)
   
9.   If Err Then arr(1)(i, 1) = ""
   
10.   On Error GoTo 0
    
11. Next
    
12. [au2].Resize(UBound(arr(0))) = arr(1)
    
13. End Sub

复制代码

lijian8003

大灰狼1976 发表于 2021-12-1 19:56

谢谢！代码简洁，运行流畅，结果正确。

大灰狼1976

抱歉，这句可能要如下修改：
If Err Then arr(1)(i, 1) = "": Err.clear
我感觉错误码不重置可能导致后续错误，但是我现在没法确认，加一句就肯定没错。

sam-wang

Sub test()
Dim Arr, Brr, Crr(), a, T$, pos%, i&
T = [ap1]
Brr = Range([x2], [x2].End(4))
Arr = Range([ar2], [ar2].End(4))
ReDim Crr(1 To UBound(Arr), 1 To 1)
For i = 1 To UBound(Arr)
    If InStr(Arr(i, 1), T) Then
        a = Split(Arr(i, 1), ",")
        pos = Application.Match(T, a, 0)
        a = Split(Brr(i, 1), ",")
        If UBound(a) < pos Then GoTo 99
        Crr(i, 1) = a(pos - 1)
99: End If
Next
[au2].Resize(UBound(Crr)) = Crr
End Sub