[已解决]请问，可以不可以用VBA实现这种效果，如附件。谢谢

新一

请问，可以不可以用VBA实现这种效果，如附件。谢谢

最佳答案

月排行榜 / 总排行榜

dsmch

2015-1-1 16:50

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro2()
   
2. Dim arr, brr, d, i&, j%, zf$, zf2$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a4").CurrentRegion
   
5. brr = Sheet2.Range("a1").CurrentRegion
   
6. For i = 4 To UBound(arr)
   
7.     zf = arr(i, 1) & "," & arr(i, 2)
   
8.     d(zf) = i
   
9. Next
   
10. For j = 3 To UBound(arr, 2)
    
11.     zf = arr(1, j) & "," & arr(2, j)
    
12.     d(zf) = j
    
13. Next
    
14. For i = 2 To UBound(brr)
    
15.     zf = brr(i, 1) & "," & brr(i, 2)
    
16.     zf2 = brr(i, 3) & "," & brr(i, 4)
    
17.     If d.exists(zf) And d.exists(zf2) Then GoTo line1
    
18.     If Not d.exists(zf) Then
    
19.         l = Range("iv1").End(xlToLeft).Column + 1 '列
    
20.         Cells(1, l) = brr(i, 1)
    
21.         Cells(2, l) = brr(i, 2)
    
22.     Else
    
23.         l = d(zf)
    
24.     End If
    
25.     If Not d.exists(zf2) Then
    
26.         h = Range("a65536").End(xlUp).Row + 1
    
27.         Cells(h, 1) = brr(i, 3)
    
28.         Cells(h, 2) = brr(i, 4)
    
29.     Else
    
30.         h = d(zf2)
    
31.     End If
    
32.     Cells(h, l) = brr(i, 5)
    
33.     d(zf) = l
    
34.     d(zf2) = h
    
35. line1:
    
36. Next
    
37. End Sub

复制代码

dsmch

………………

新一

谢谢老师{:18:}