[已解决]三个条件的组合判断

markang

期望达到的目的:程序判断A列单元格最前两字母和最后三字母,以及B列对应单元格第二和第三的内容,从sheet 2中找出对应关系然后在C列自动填上数字.
由于这只是个例子,现实中要处理类似的很大的数据,能否做成循环的语句?即有n行的类似数据,怎么编写?

最佳答案

月排行榜 / 总排行榜

grf1973

2015-4-21 09:30

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheet2.Range("a1:e" & Sheet2.[e65536].End(3).Row)
   
4.     For i = 2 To UBound(arr)
   
5.         If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1)
   
6.         For j = 3 To UBound(arr, 2)
   
7.             If arr(i, 2) <> "" Then d(arr(i, 1) & "," & arr(i, 2) & "," & arr(1, j)) = arr(i, j)
   
8.         Next
   
9.     Next
   
10.     arr = [a1].CurrentRegion
    
11.     ReDim brr(1 To UBound(arr), 1 To 1)
    
12.     For i = 1 To UBound(arr)
    
13.         x = Left(arr(i, 1), 2) & "," & Right(arr(i, 1), 3) & "," & Mid(arr(i, 2), 2, 2)
    
14.         brr(i, 1) = d(x)
    
15.     Next
    
16.     [c1].Resize(UBound(brr)) = brr
    
17. End Sub

复制代码

跳转到最佳答案楼层

雪舞子

1. Sub test()
   
2.     Dim arr, brr(), i%, j%, k%, rng As Range
   
3.     arr = [a1].CurrentRegion
   
4.     ReDim brr(1 To UBound(arr), 1 To 1)
   
5.     For i = 1 To UBound(arr)
   
6.         Set rng = Sheet2.Columns(1).Find(Left(arr(i, 1), 2), , , xlWhole)
   
7.         If Not rng Is Nothing Then
   
8.             For j = 1 To 3
   
9.                 If Right(arr(i, 1), 3) = rng(j, 2) Then Exit For
   
10.             Next
    
11.             If j < 4 Then
    
12.                 For k = 3 To 5
    
13.                     If Mid(arr(i, 2), 2, 2) = rng(0, k) Then Exit For
    
14.                 Next
    
15.                 If k < 6 Then
    
16.                     brr(i, 1) = rng(j, k).Value
    
17.                 End If
    
18.             End If
    
19.         End If
    
20.     Next
    
21.     [c1].Resize(UBound(brr)) = brr
    
22. End Sub
    

复制代码

三个条件组合判断.rar (17.85 KB, 下载次数: 9)

2015-4-20 21:40 上传

点击文件名下载附件

grf1973

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheet2.Range("a1:e" & Sheet2.[e65536].End(3).Row)
   
4.     For i = 2 To UBound(arr)
   
5.         If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1)
   
6.         For j = 3 To UBound(arr, 2)
   
7.             If arr(i, 2) <> "" Then d(arr(i, 1) & "," & arr(i, 2) & "," & arr(1, j)) = arr(i, j)
   
8.         Next
   
9.     Next
   
10.     arr = [a1].CurrentRegion
    
11.     ReDim brr(1 To UBound(arr), 1 To 1)
    
12.     For i = 1 To UBound(arr)
    
13.         x = Left(arr(i, 1), 2) & "," & Right(arr(i, 1), 3) & "," & Mid(arr(i, 2), 2, 2)
    
14.         brr(i, 1) = d(x)
    
15.     Next
    
16.     [c1].Resize(UBound(brr)) = brr
    
17. End Sub

复制代码

markang

两位的解决方案都很完美,只是我水平实在差看不懂啊
先来看看雪舞子 的答案,能帮忙补齐每一句的意思吗?
Sub test()
    Dim arr, brr(), i%, j%, k%, rng As Range
    '定义arr,brr动态数组,i%,j%,k%,rng为单元格,在字母后面为什么要拖一个百分比?
    arr = [a1].CurrentRegion
    'arr为sheet1中以a1单元格展开的边界区域(currentregion指的是以某点向周围空白处扩散的区域?)
    ReDim brr(1 To UBound(arr), 1 To 1)
    '重新定义brr为第一行至最后一行,a列的单元格
    For i = 1 To UBound(arr)
    '这个i和最上面的i%是同一个i吗?
        Set rng = Sheet2.Columns(1).Find(Left(arr(i, 1), 2), , , xlWhole)
        '用sheet2的第一列同sheet1中第一列单元格中从左数开始的2个字节做完全匹配
        If Not rng Is Nothing Then
        '如果存在满足上述匹配条件的单元格则
            For j = 1 To 3
            
                If Right(arr(i, 1), 3) = rng(j, 2) Then Exit For
                '上面什么意思?
            Next
            If j < 4 Then
                For k = 3 To 5
                    If Mid(arr(i, 2), 2, 2) = rng(0, k) Then Exit For
                Next
                If k < 6 Then
                    brr(i, 1) = rng(j, k).Value
                End If
            End If
        End If
    Next
    [c1].Resize(UBound(brr)) = brr
End Sub