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

zax010

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


(更新).rar (69.86 KB, 下载次数: 24)

2015-9-18 13:23 上传

点击文件名下载附件

hyjianjian

zax010 发表于 2015-9-18 13:23
>>>>>>>>>>>>>>>>>>>>>>

zax010:

        ar = .Sheets(2).Range("A2:R" & lr)  不可以修改成这样？ 有工程密码，我无法查找原因！
答案是正确的！ 我原本是说返回一整行的原因是（A~R 列 18列数据！） 现在返回的是A~I 列数据.
有个小问题， 假如我要查找的 本身就是0 （C列中）  现在的逻辑则不会返回自己！  本身就是0 则不用向上查找，直接返回自己本身行数 信息

在工作簿2 中 查到对应的F列     判断C列 是否为0  如果为0 则直接返回自己， 如果不为0 则向上查找第一个出现0的

能否实现 将工作簿2 搜索范围 扩展至  sheet2~sheet5

谢谢！

hyjianjian

zax010 发表于 2015-9-18 13:23
>>>>>>>>>>>>>>>>>>>>>>

1. Sub zz()
   
2.     Dim ar, br, mb, wb As Workbook
   
3.     mb = Sheet1.[a1].CurrentRegion
   
4.     Application.ScreenUpdating = False
   
5.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\2.xls")
   
6.     With wb
   
7.         lr = .Sheets(2).Range("A65536").End(3).Row
   
8.         ar = .Sheets(2).Range("A2:R" & lr)
   
9.         .Close False
   
10.     End With
    
11.     For w = 2 To UBound(mb)
    
12.         ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
    
13.         br(1, 1) = mb(w, 1): m = 1
    
14.         For i = 1 To UBound(ar)
    
15.             If ar(i, 6) = mb(w, 1) Then
    
16.                 k = i: m = m + 1
    
17.                 For x = k To 1 Step -1
    
18.                     If ar(x, 3) = 0 Then
    
19.                         For j = 1 To UBound(br, 2)
    
20.                             br(m, j) = ar(x, j)
    
21.                         Next
    
22.                         Exit For
    
23.                     End If
    
24.                 Next
    
25.             End If
    
26.         Next
    
27.         Sheet2.Cells(2 + n, 1).Resize(m, UBound(br, 2)) = br
    
28.         n = n + m + 1
    
29.     Next
    
30.     Application.ScreenUpdating = True
    
31. End Sub

复制代码

3个优化点：

1   当出现需要搜索    本身就是 C列为0 的时候   能否 改成  返回自己行数即可？

2   能否扩展搜索范围？  sheet2 ~ sheet5？

3   能否改成以 =left（10） 方式就行搜索？  以349163-0010   为例子     及时以349163-001   也能正确搜索并返回行数？   现在返回为空


谢谢，麻烦你留意！

hyjianjian

zax010 发表于 2015-9-18 13:21
主要是改变 br 数组的设置而已：

Sub zz()

如果我想在原有 语句 插入   br(m, 2) = ar(i, 9)
            If ar(i, 6) = mb(w, 1) Then
                k = i: m = m + 1
                br(m, 2) = ar(i, 9)     sheet2   A列
                br(m, 2) = ar(i, 8)     sheet2   B列

要如何实现？

1. Sub zz()
   
2.     Dim ar, br, mb, wb As Workbook
   
3.     mb = Sheet1.[a1].CurrentRegion
   
4.     Application.ScreenUpdating = False
   
5.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\2.xlsx")
   
6.     With wb
   
7.         lr = .Sheets(2).Range("A1048576").End(3).Row
   
8.         ar = .Sheets(2).Range("A2:R" & lr)
   
9.         .Close False
   
10.     End With
    
11.     For w = 2 To UBound(mb)
    
12.         ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
    
13.         br(1, 1) = mb(w, 1): m = 1
    
14.         For i = 1 To UBound(ar)
    
15.             If ar(i, 6) = mb(w, 1) Then
    
16.                 k = i: m = m + 1
    
17.                 For x = k To 1 Step -1
    
18.                     If ar(x, 3) = 0 Then
    
19.                         For j = 1 To UBound(br, 2)
    
20.                             br(m, j) = ar(x, j)
    
21.                         Next
    
22.                         Exit For
    
23.                     End If
    
24.                 Next
    
25.             End If
    
26.         Next
    
27.         Sheet2.Cells(2 + n, 1).Resize(m, UBound(br, 2)) = br
    
28.         n = n + m + 1
    
29.     Next
    
30.     Application.ScreenUpdating = True
    
31. End Sub

复制代码

在shtee2  A列里！   原先的只返回 C~R列！    对应 sheet2  C~R列！

hyjianjian

zax010 发表于 2015-9-18 13:23
>>>>>>>>>>>>>>>>>>>>>>

zax010，麻烦关注下求助http://club.excelhome.net/forum. ... =8417603&page=1

hyjianjian

zax010 发表于 2015-9-17 10:00
其实，弄清楚要求，题目还算简单：

Sub zz()

大侠，有个BOM查找相关求助。恳请你关注

http://club.excelhome.net/thread-1250927-1-1.html

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)

大侠烦请您帮忙解决难题http://club.excelhome.net/thread-1260773-1-1.html

hyjianjian

zax010 发表于 2015-9-18 13:21
主要是改变 br 数组的设置而已：

Sub zz()

zax010：

         如何对输出结果 F列 去重复？
         对输出结果既（ar(i, 6)）   F列  如有重复只显示一条。
图片中，sheet2 F列涂色为重复（并非单纯 sheet2 工作表 整列去重复！  而是对应匹配F列搜索输出的值去重复！）


恳请协助，谢谢！

1. Sub zax010()
   
2.     Dim ar, br, mb, wb As Workbook
   
3.     mb = Sheet1.[a1].CurrentRegion
   
4.     Application.ScreenUpdating = False
   
5.     Sheet2.Activate
   
6.     Cells.Clear
   
7.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\1.xls")
   
8.     With wb
   
9.         lr = .Sheets(1).Range("A65536").End(3).Row
   
10.         ar = .Sheets(1).Range("A2:V" & lr)
    
11.         .Close False
    
12.     End With
    
13.     For w = 2 To UBound(mb)
    
14.         ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
    
15.         br(1, 1) = mb(w, 1): m = 1
    
16.         For i = 1 To UBound(ar)
    
17.             If ar(i, 6) = mb(w, 1) And ar(i, 10) > 0 Then
    
18.                 k = i: m = m + 1
    
19.                 For x = k To 1 Step -1
    
20.                     If ar(x, 3) = 0 Then
    
21.                         For j = 1 To UBound(br, 2)
    
22.                             br(m, j) = ar(x, j)
    
23.                             br(m, 1) = ar(i, 10)
    
24.                             br(m, 2) = ar(i, 7)
    
25.                             br(m, 3) = ar(i, 8)
    
26.                         Next
    
27.                         Exit For
    
28.                     End If
    
29.                 Next
    
30.             End If
    
31.         Next
    
32.         Sheet2.Cells(2 + n, 1).Resize(m, UBound(br, 2)) = br
    
33.         n = n + m + 1
    
34.     Next
    
35.     Cells.EntireColumn.AutoFit
    
36.     Application.ScreenUpdating = True
    
37. End Sub

复制代码