用VBA 根据条件 反馈回相应的数值!

hyjianjian

各位大侠：                附件里有工作簿1（ 获取sheet1 A2列 开始 最大行数） 与 工作簿2 第一行为标题行   8列（A~R列固定）  第二行开始 获取最大行数

                希望实现功能如下：
                根据工作簿1 里的sheet1  A列第二行开始的数值    去   工作簿2 里 sheet2  对应的F列   依据C列向上查找 当出现第一个0时候停止  将0对应的F列数值反馈回 工作簿1 sheet2里（如有重复  只记录一个！）

                工作簿1 sheet2 B列 必要数量  则   根据sheet1  A列 数值  去  工作簿2 里 sheet2  对应的F列   （不需要向上查找） 将I列（第9列） 数值  反馈回工作簿1 sheet2 B列（不是向上找0的I列）
               
                工作簿1  sheet1 A  有多行    每查找完 一行  希望在 工作簿1 sheet2  空一行  并以工作簿1  sheet1 A   做好标识（用颜色分开一个！2个颜色循环）

               
                 类似于  以工作簿1 sheet1  A列    在    工作簿2 里 sheet2   做    查找全部 ！   对应的  工作簿2 里 sheet2  F列     中   以C列 向上查找0   然后将F列反馈回工作簿1 sheet2  A列



附件里以  做例子！

626941-0051

349252-9130

huang1314wei

看不懂描述，要查找的代码与生成的结果怎么没有关系

hyjianjian

huang1314wei 发表于 2015-9-16 06:54
看不懂描述，要查找的代码与生成的结果怎么没有关系

是 工作簿2 F列是对应的代码！C列是他们的等级。我是要他们0级  对应的F列代码！

蓝桥玄霜

1. Sub lqxs()
   
2. Dim Arr, i&, myPath$, myName$, Arr1, n&, cz$
   
3. myPath = ThisWorkbook.Path & ""
   
4. myName = "2.xlsx"
   
5. With GetObject(myPath & myName)
   
6.     Arr1 = .Sheets(2).Range("A1").CurrentRegion
   
7.     .Close False
   
8. End With
   
9. Sheet2.Activate
   
10. [a2:b500].ClearContents: n = 1
    
11. Arr = Sheet1.[a1].CurrentRegion
    
12. For i = 2 To UBound(Arr)
    
13.     cz = Arr(i, 1)
    
14.     For j = 2 To UBound(Arr1)
    
15.         If Arr1(j, 6) = cz Then
    
16.             For x = j To 2 Step -1
    
17.                 If Arr1(x, 3) = 0 Then
    
18.                     n = n + 1
    
19.                     Cells(n, 1) = Arr1(x, 6): Cells(n, 2) = 0: Exit For
    
20.                 End If
    
21.             Next
    
22.         End If
    
23.     Next
    
24. Next
    
25. End Sub
    

复制代码

蓝桥玄霜

请见附件。

zax010

Sub zz()
    Dim ar, br, wb As Workbook
    mb = Sheet1.[a2]: ReDim br(1 To 50, 1 To 2)
    Application.ScreenUpdating = False
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\2.xlsx")
    With wb
        ar = .Sheets(2).Range("A1").CurrentRegion
        .Close False
    End With
    For i = 1 To UBound(ar)
        If ar(i, 6) = mb Then
            k = i
            For x = k To 1 Step -1
                If ar(x, 3) = 0 Then
                    m = m + 1
                    br(m, 1) = ar(x, 6)
                    br(m, 2) = ar(x, 3)
                    Exit For
                End If
            Next
        End If
    Next
    Sheet2.Range("A2").Resize(m, 2) = br
    Application.ScreenUpdating = True
End Sub

zax010

>>>>>>>>>>>>>>>>>>>>>>>>


求助.rar (68.05 KB, 下载次数: 21)

2015-9-16 11:22 上传

点击文件名下载附件

hyjianjian

蓝桥玄霜 发表于 2015-9-16 10:52

蓝版主果然对bom熟悉，表述不清地方，晚上再跟你提出。恳请继续协助。谢谢！

hyjianjian

蓝桥玄霜 发表于 2015-9-16 10:53
请见附件。

各位，工作簿1sheet2的A列是正确。B列必要数无法正确获取！都是0   必要数是指  对应F列的 I行（第九列）。不用向上查找！

hyjianjian

zax010 发表于 2015-9-16 11:19
Sub zz()
    Dim ar, br, wb As Workbook
    mb = Sheet1.[a2]: ReDim br(1 To 50, 1 To 2)

zax010
感谢你的帮助，发现些问题点！可能我之前表述不清。1：  工作簿1 sheet1 A列 不能实现 多列一起查找！ 只有sheet1 A1列有效。可以改成自动获取它的最大列数吗？
2：  工作簿1 sheet1 B列 反馈的数字不正确！ 我是想返回  工作表2 sheet2 i列（第九列）数值！这个数值，是根据工作簿1 sheet1 A列   直接去 工作簿2 sheet2 I列的数值！ 这个必要数  不是向上查找0 对应的F列 的  I列数值！


更正下！
             工作簿2 sheet2  第一行为标题行， 有8列（固定）A~R列    行数不固定！