[已解决]VBA数值范围之间对比后赋值

crudeoil123

例如范围Ａ５０-５５，代码１，范围Ｂ５１-５４，可见范围Ｂ在范围Ａ之间，将代码１赋值给范围Ｂ。具体见附件表，谢谢大神帮忙啊。

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-7-3 20:43

自己验证下！

1. Sub xx()
   
2.     Dim arr, i&, n&, n1&, j&
   
3.     With Sheet1
   
4.         n = .Cells(.Rows.Count, 1).End(xlUp).Row
   
5.         arr = .Range("A2:D" & n)
   
6.     End With
   
7.     Application.ScreenUpdating = False
   
8.     With Sheet2
   
9.         n1 = .Cells(.Rows.Count, 1).End(xlUp).Row
   
10.         .Range("B2:B" & n).ClearContents
    
11.         For i = 2 To n1
    
12.             For j = 1 To n - 1
    
13.                 If Replace(.Cells(i, 1), "英", "") = arr(j, 1) And .Cells(i, 3) >= arr(j, 3) And .Cells(i, 4) <= arr(j, 4) Then
    
14.                     .Cells(i, 2) = arr(j, 2)
    
15.                     Exit For
    
16.                 End If
    
17.             Next
    
18.         Next
    
19.     End With
    
20.     Application.ScreenUpdating = True
    
21. End Sub

复制代码

跳转到最佳答案楼层

老司机带带我

自己验证下！

1. Sub xx()
   
2.     Dim arr, i&, n&, n1&, j&
   
3.     With Sheet1
   
4.         n = .Cells(.Rows.Count, 1).End(xlUp).Row
   
5.         arr = .Range("A2:D" & n)
   
6.     End With
   
7.     Application.ScreenUpdating = False
   
8.     With Sheet2
   
9.         n1 = .Cells(.Rows.Count, 1).End(xlUp).Row
   
10.         .Range("B2:B" & n).ClearContents
    
11.         For i = 2 To n1
    
12.             For j = 1 To n - 1
    
13.                 If Replace(.Cells(i, 1), "英", "") = arr(j, 1) And .Cells(i, 3) >= arr(j, 3) And .Cells(i, 4) <= arr(j, 4) Then
    
14.                     .Cells(i, 2) = arr(j, 2)
    
15.                     Exit For
    
16.                 End If
    
17.             Next
    
18.         Next
    
19.     End With
    
20.     Application.ScreenUpdating = True
    
21. End Sub

复制代码

crudeoil123

老司机带带我 发表于 2016-7-3 20:43
自己验证下！

多谢，测试后没有问题