急，急，急请各位大神帮帮忙~~

FDBGN

数据如附件 按照条件查找.zip (11.44 KB, 下载次数: 1)

2019-12-17 22:42 上传

点击文件名下载附件

我想要实现的效果如下图表二，需要在EXCEL表里添加一个查询按钮
只要输入LOT例如：输入”E6L456”就会查询出这个LOT底下下线过哪些夕批以及每个夕批下的刻号和每个刻号所对应的数量，左边的SUM是每个刻号所对应数量的和，请各位大神帮忙，感谢~
        

liulang0808

1. Sub 按钮1_Click()
   
2.     If Len([c3]) > 0 Then
   
3.         arr = Sheets(1).UsedRange
   
4.         Application.ScreenUpdating = False
   
5.         r = Cells(Rows.Count, 2).End(3).Row
   
6.         [b7].Resize(r, 6).ClearContents
   
7.         r = 7
   
8.         c = 5
   
9.         For j = 2 To UBound(arr)
   
10.             If arr(j, 1) = [c3] Then
    
11.                 If InStr(arr(j, 3), ".") > 0 Then
    
12.                     brr = Split(arr(j, 3), ".")
    
13.                     crr = Split(arr(j, 4), ".")
    
14.                     Cells(7, c) = arr(j, 2)
    
15.                     If c = 5 Then
    
16.                         r = 7
    
17.                     Else
    
18.                         r = Cells(Rows.Count, 2).End(3).Row + 1
    
19.                     End If
    
20.                     Cells(r, 2).Resize(UBound(brr) + 1) = WorksheetFunction.Transpose(brr)
    
21.                     Cells(r, 3).Resize(UBound(crr) + 1) = WorksheetFunction.Transpose(crr)
    
22.                     Cells(r, c).Resize(UBound(crr) + 1) = WorksheetFunction.Transpose(crr)
    
23.                     c = c + 1
    
24.                     
    
25.                 Else
    
26.                     If c = 5 Then
    
27.                         r = 7
    
28.                     Else
    
29.                         r = Cells(Rows.Count, 2).End(3).Row + 1
    
30.                     End If
    
31.                     Cells(r, 2) = arr(j, 3)
    
32.                     Cells(r, 3) = arr(j, 4)
    
33.                     Cells(r, c) = arr(j, 4)
    
34.                     c = c + 1
    
35.                 End If
    
36.             End If
    
37.         Next j
    
38.         Application.ScreenUpdating = True
    
39.     End If
    
40. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。

FDBGN

非常感谢,买了别怕EXCEL VBA很简单,这本书目前已经看完,很好。但是有时还是不太会用,一会会经常来论坛向大神们学习,感谢

FDBGN

求大神指点，执行完后和想要的不一样，是我哪里吗弄错了，因为我是初学者，w请再帮忙指点下，感谢~~

liulang0808

1. Sub 按钮1_Click()
   
2.     If Len([c3]) > 0 Then
   
3.         arr = Sheets(1).UsedRange
   
4.         Application.ScreenUpdating = False
   
5.         r = Cells(Rows.Count, 2).End(3).Row
   
6.         [b7].Resize(r, 6).ClearContents
   
7.         r = 7
   
8.         c = 5
   
9.         For j = 2 To UBound(arr)
   
10.             If arr(j, 1) = [c3] Then
    
11.                 If InStr(arr(j, 3), ".") > 0 Then
    
12.                     brr = Split(arr(j, 3), ".")
    
13.                     crr = Split(arr(j, 4), ".")
    
14.                     Cells(6, c) = arr(j, 2)
    
15.                     If c = 5 Then
    
16.                         r = 7
    
17.                     Else
    
18.                         r = Cells(Rows.Count, 2).End(3).Row + 1
    
19.                     End If
    
20.                     Cells(r, 2).Resize(UBound(brr) + 1) = WorksheetFunction.Transpose(brr)
    
21.                     Cells(r, 3).Resize(UBound(crr) + 1) = WorksheetFunction.Transpose(crr)
    
22.                     Cells(r, c).Resize(UBound(crr) + 1) = WorksheetFunction.Transpose(crr)
    
23.                     c = c + 1
    
24.                     
    
25.                 Else
    
26.                     If c = 5 Then
    
27.                         r = 7
    
28.                     Else
    
29.                         r = Cells(Rows.Count, 2).End(3).Row + 1
    
30.                     End If
    
31.                     Cells(r, 2) = arr(j, 3)
    
32.                     Cells(r, 3) = arr(j, 4)
    
33.                     Cells(r, c) = arr(j, 4)
    
34.                     c = c + 1
    
35.                 End If
    
36.             End If
    
37.         Next j
    
38.         Application.ScreenUpdating = True
    
39.     End If
    
40. End Sub
    

复制代码

liulang0808

。。。。。。。。。。。。。。