[已解决]求教VBA解决数据的一一对应

oubaiyas122

各位大师好：
         本次求助内容为：需从每块数据中（一块数据15行）取一列为UserLabel值，一列为<V i="14">的值。因为有很多这样的块。故求教VBA解决。详见附件。谢谢。

最佳答案

月排行榜 / 总排行榜

grf1973

2015-10-15 13:25

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     a = "UserLabel"
   
4.     b = "<V i=" & Chr(34) & "14" & Chr(34) & ">"
   
5.     Dim brr(1 To 100, 1 To 2)
   
6.     For i = 1 To UBound(arr)
   
7.         x = arr(i, 1)
   
8.         If InStr(x, a) > 0 Then
   
9.             na = na + 1
   
10.             y = Split(x, a)(1)
    
11.             brr(na, 1) = Mid(y, 3, 1)
    
12.         End If
    
13.         If InStr(x, b) > 0 Then
    
14.             nb = nb + 1
    
15.             y = Split(x, b)(1)
    
16.             brr(nb, 2) = Mid(y, 1, 1)
    
17.         End If
    
18.     Next
    
19.     n = IIf(na > nb, na, nb)
    
20.     If n > 0 Then [e2].Resize(n, 2) = brr
    
21. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     a = "UserLabel"
   
4.     b = "<V i=" & Chr(34) & "14" & Chr(34) & ">"
   
5.     Dim brr(1 To 100, 1 To 2)
   
6.     For i = 1 To UBound(arr)
   
7.         x = arr(i, 1)
   
8.         If InStr(x, a) > 0 Then
   
9.             na = na + 1
   
10.             y = Split(x, a)(1)
    
11.             brr(na, 1) = Mid(y, 3, 1)
    
12.         End If
    
13.         If InStr(x, b) > 0 Then
    
14.             nb = nb + 1
    
15.             y = Split(x, b)(1)
    
16.             brr(nb, 2) = Mid(y, 1, 1)
    
17.         End If
    
18.     Next
    
19.     n = IIf(na > nb, na, nb)
    
20.     If n > 0 Then [e2].Resize(n, 2) = brr
    
21. End Sub
    

复制代码

grf1973

请看附件。

oubaiyas122

grf1973 发表于 2015-10-15 13:26
请看附件。

第11行代码下标越界了。

grf1973

数据量很大？把第5句改大一点
Dim brr(1 To 10000, 1 To 2)

oubaiyas122

grf1973 发表于 2015-10-15 13:41
数据量很大？把第5句改大一点
Dim brr(1 To 10000, 1 To 2)

按照你说的改了就对了，谢谢！