[已解决]关于VBA多条件引用的问题

岳志锦

现在我有两个表格，一个是BOM清单，一个是库存明细表，我想达到的目的是当BOM清单中点击确认出库的时候，库存明细表会扣除当日的数量，但是现在发现一个问题，当BOM清单里面的零件名称是一样的时候，库存表扣除就乱了，现在我想再加入一个条件来引用，就是零件规格，麻烦各位大神帮我修改一下，谢谢！！
Sub lqxs()
Dim Arr, i&, rq, wb As Workbook
Dim d, k, t, r1
Set d = CreateObject("Scripting.Dictionary")
Sheet1.Activate
Arr = [a1].CurrentRegion
rq = Arr(1, 8)
For i = 3 To UBound(Arr)
    If Arr(i, 4) = "" Then Exit For
    d(Arr(i, 4)) = Arr(i, 6)
Next
k = d.keys: t = d.items
Set wb = Workbooks("配件收发存明细表.xlsx")
Dim Sht As Worksheet
For i = 0 To UBound(k)
    For Each Sht In wb.Sheets
        If InStr(Sht.Name, k(i)) Then
            Set r1 = Sht.[a:a].Find(rq, , , 1)
            If Not r1 Is Nothing Then
                Sht.Cells(r1.Row, 4) = t(i)
            End If
        End If
    Next
Next
Application.DisplayAlerts = False
wb.Close True
Application.DisplayAlerts = True
End Sub

最佳答案

月排行榜 / 总排行榜

冥王

2015-5-24 15:38

1. Sub lqxs()
   
2.     Dim Arr, i&, rq, wb As Workbook
   
3.     Dim d, k, t, r1
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Sheet1.Activate
   
6.     Arr = [a1].CurrentRegion
   
7.     rq = Arr(1, 8)
   
8.     For i = 3 To UBound(Arr)
   
9.         If Arr(i, 4) = "" Then Exit For
   
10.         d(Arr(i, 4) & "#" & Arr(i, 5)) = Arr(i, 6)
    
11.     Next
    
12.     k = d.keys: t = d.items
    
13.     Set wb = Workbooks("配件收发存明细表.xlsx")
    
14.     Dim Sht As Worksheet
    
15.     For i = 0 To UBound(k)
    
16.         For Each Sht In wb.Sheets
    
17.             If InStr(Sht.Name, Split(k(i), "#")(0)) Then
    
18.                 If Sht.Cells(2, 2) = Replace(k(i), "#", "") Then
    
19.                     Set r1 = Sht.[a:a].Find(rq, , , 1)
    
20.                     If Not r1 Is Nothing Then
    
21.                         Sht.Cells(r1.Row, 4) = t(i)
    
22.                     End If
    
23.                 End If
    
24.             End If
    
25.         Next
    
26.     Next
    
27.     Application.DisplayAlerts = False
    
28.     wb.Save
    
29.     Application.DisplayAlerts = True
    
30. End Sub

复制代码

跳转到最佳答案楼层

岳志锦

补充问题：这个代码每次点确认都会把明细表关掉，怎样才能点击确认后明细表不关掉呢，因为这只是一个产品的BOM，还有其他产品要计算，每次都要把明细表打开。。。。比较痛苦

冥王

1. Sub lqxs()
   
2.     Dim Arr, i&, rq, wb As Workbook
   
3.     Dim d, k, t, r1
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Sheet1.Activate
   
6.     Arr = [a1].CurrentRegion
   
7.     rq = Arr(1, 8)
   
8.     For i = 3 To UBound(Arr)
   
9.         If Arr(i, 4) = "" Then Exit For
   
10.         d(Arr(i, 4) & "#" & Arr(i, 5)) = Arr(i, 6)
    
11.     Next
    
12.     k = d.keys: t = d.items
    
13.     Set wb = Workbooks("配件收发存明细表.xlsx")
    
14.     Dim Sht As Worksheet
    
15.     For i = 0 To UBound(k)
    
16.         For Each Sht In wb.Sheets
    
17.             If InStr(Sht.Name, Split(k(i), "#")(0)) Then
    
18.                 If Sht.Cells(2, 2) = Replace(k(i), "#", "") Then
    
19.                     Set r1 = Sht.[a:a].Find(rq, , , 1)
    
20.                     If Not r1 Is Nothing Then
    
21.                         Sht.Cells(r1.Row, 4) = t(i)
    
22.                     End If
    
23.                 End If
    
24.             End If
    
25.         Next
    
26.     Next
    
27.     Application.DisplayAlerts = False
    
28.     wb.Save
    
29.     Application.DisplayAlerts = True
    
30. End Sub

复制代码

岳志锦

厉害厉害厉害，谢谢啦！！

冥王

在你原先的代码基础上只改动了一点点