[已解决]VBA查找与判断

sunshinegg

用E列里的数据挨个去a列里搜索，
1.如果有将对应行里的数值填到B列，例如：第一行
2.如果有，且B列里已经有数值了，就把对应行的数值填到C.例如：第二行
3.如果没有就在G列里填一个X（字母X),例如：第三行

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2013-7-8 21:36

附件请测试

1. Private Sub CommandButton1_Click()
   
2. Dim arr, i&, j&
   
3. arr = UsedRange
   
4. ReDim Preserve arr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
   
5. For j = 1 To UBound(arr)
   
6.   K = 0
   
7.   For i = 1 To UBound(arr)
   
8.     If arr(j, 5) = arr(i, 1) Then
   
9.       If arr(i, 2) = "" Then
   
10.         arr(i, 2) = arr(j, 6)
    
11.       Else
    
12.         arr(i, 3) = arr(j, 6)
    
13.       End If
    
14.       K = K + 1
    
15.     End If
    
16.   Next i
    
17.   If K = 0 Then arr(j, 7) = "X"
    
18. Next j
    
19. [A1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
20. End Sub

复制代码

跳转到最佳答案楼层

sunshinegg

求助啊 各位帮帮看看应该如何做

w2001pf

发个附件，明确要求。

大灰狼1976

附件请测试

1. Private Sub CommandButton1_Click()
   
2. Dim arr, i&, j&
   
3. arr = UsedRange
   
4. ReDim Preserve arr(1 To UBound(arr), 1 To UBound(arr, 2) + 1)
   
5. For j = 1 To UBound(arr)
   
6.   K = 0
   
7.   For i = 1 To UBound(arr)
   
8.     If arr(j, 5) = arr(i, 1) Then
   
9.       If arr(i, 2) = "" Then
   
10.         arr(i, 2) = arr(j, 6)
    
11.       Else
    
12.         arr(i, 3) = arr(j, 6)
    
13.       End If
    
14.       K = K + 1
    
15.     End If
    
16.   Next i
    
17.   If K = 0 Then arr(j, 7) = "X"
    
18. Next j
    
19. [A1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
20. End Sub

复制代码

无聊的疯子

用函数都可以达到要求。。。