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

hyjianjian

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

感谢你的帮助。
2：  工作簿1 sheet1 B列 反馈的数字不正确！ 我是想返回  工作表2 sheet2 i列（第九列）数值！这个数值，是根据工作簿1 sheet1 A列   直接去 工作簿2 sheet2 I列的数值！ 这个必要数  不需要向上查找0 对应的F列 的  I列数值！也不是第三列的数值。


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

hyjianjian

附件已经更新！ 请各位查阅！ 感谢帮助！

zax010

hyjianjian 发表于 2015-9-16 19:05
zax010
感谢你的帮助，发现些问题点！可能我之前表述不清。1：  工作簿1 sheet1 A列 不能实现 多列一起 ...

肯定是你没说清楚。连蓝版这样的超级大师都被误导了，何况我等？
倒是2楼大神聪明，弄不清情况不下手。

zax010

hyjianjian 发表于 2015-9-16 19:05
zax010
感谢你的帮助，发现些问题点！可能我之前表述不清。1：  工作簿1 sheet1 A列 不能实现 多列一起 ...

其实，弄清楚要求，题目还算简单：

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

zax010

hyjianjian 发表于 2015-9-16 19:05
zax010
感谢你的帮助，发现些问题点！可能我之前表述不清。1：  工作簿1 sheet1 A列 不能实现 多列一起 ...

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

求助(更新).rar (69.9 KB, 下载次数: 13)

2015-9-17 10:03 上传

点击文件名下载附件

hyjianjian

zax010 发表于 2015-9-17 10:03
>>>>>>>>>>>>>>>>>>>>>>>>>

感谢帮助，抱歉之前没表述清楚
ReDim br(1 To 50, 1 To 2) 这句话是不是限制了 工作表1 sheet1 A列的行数？假如，我需要查找有600行，要改成1 To 600？ 实际应用中，多行查找 br(m,2)=ar(i,9) 会报错

zax010

hyjianjian 发表于 2015-9-17 13:24
感谢帮助，抱歉之前没表述清楚
ReDim br(1 To 50, 1 To 2) 这句话是不是限制了 工作表1 sheet1 A列的行 ...

工作表1 sheet1 A列数据装在mb 数组中，与br 数组大小无关。

针对每一个mb 中的值，都重定义一个br 数组，用于临时存放查询出来的结果。

一般认为，一条mb的数据，50个查询结果差不多了。如果不够，可自行增加到500、5000甚至50000都可以
，因不知到底有多少数据量，只定义50行。

仔细查看一下 ReDim br(1 To 50, 1 To 2) 在代码中的位置并不难理解。

hyjianjian

zax010 发表于 2015-9-17 14:13
工作表1 sheet1 A列数据装在mb 数组中，与br 数组大小无关。

针对每一个mb 中的值，都重定义一个br 数 ...

zax010：将   ReDim br(1 To 50, 1 To 2)  改成  ReDim br(1 To 5000, 1 To 2)    后    br(m, 2) = ar(i, 9) 不会再提示 越界了！ 能够正确实施！感谢帮助！

zax010 能否实现  

• 反馈为符合项的 一整行？ I列 不用反馈！  工作簿2 sheet2 对应的F列   以第三列 向上查找第一个出现0    反馈回一整行（共18列 A~R列）
  

   
      查找范围由原先的工作簿2  sheet2  扩展至  sheet2 ~ sheet5  格式相同！ 4个工作表格式相同！


输出格式保持原本格式   sheet1 A列 搜索完后空一行。

hyjianjian

zax010 发表于 2015-9-17 14:13
工作表1 sheet1 A列数据装在mb 数组中，与br 数组大小无关。

针对每一个mb 中的值，都重定义一个br 数 ...

附件已更新，请查看

zax010

hyjianjian 发表于 2015-9-18 12:38
附件已更新，请查看

主要是改变 br 数组的设置而已：

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