求VB语序

jordanlive · 发表于 2024-8-8 10:25

求个VB程序

3190496160 · 发表于 2024-8-8 10:40

获取到的产品型号，放到什么地方？？？

jordanlive · 发表于 2024-8-8 10:42

3190496160 发表于 2024-8-8 10:40
获取到的产品型号，放到什么地方？？？

流水线表中的从第71行开始的B列

longwin · 发表于 2024-8-8 10:48

Sub test()
Set d = CreateObject("scripting.dictionary")
arr = Sheets("日报表").[b1].CurrentRegion
bz = Sheets("流水线").[b1].Value
For i = 7 To UBound(arr)
      If arr(i, 4) = bz Then
         d(arr(i, 3)) = 1
      End If
Next
Sheets("流水线").Range("B71:B" & Sheets("流水线").[b71].End(xlDown).Row).ClearContents
Sheets("流水线").[b71].Resize(d.Count, 1) = WorksheetFunction.Transpose(d.keys)
Sheets("流水线").[b71].Resize(d.Count, 1).Borders.Weight = xlThin
Set d = Nothing
End Sub

3190496160 · 发表于 2024-8-8 10:50

Sub 查询()
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("日报表")
r = .Cells(Rows.Count, 4).End(xlUp).Row
y = .Cells(1, Columns.Count).End(xlToLeft).Column
If r < 7 Then MsgBox "日报表为空！": End
ar = .Range("c6:d" & r)
End With
With Sheets("流水线")
zd = .[b1]
If zd = "" Then MsgBox "查询条件为空！": End
For i = 2 To UBound(ar)
      If ar(i, 2) = zd Then
         If ar(i, 1) <> "" Then
            d(ar(i, 1)) = ""
         End If
      End If
Next i
If d.Count = 0 Then End
rs = .Cells(Rows.Count, 2).End(xlUp).Row
If rs > 70 Then .Range("b71:b" & rs) = Empty
.[b71].Resize(d.Count, 1) = Application.Transpose(d.keys)
End With
Set d = Nothing
MsgBox "ok!"
End Sub

3190496160 · 发表于 2024-8-8 10:50

3190496160 · 发表于 2024-8-8 10:51

报表.rar (30.58 KB, 下载次数: 5)

		自动登录	找回密码
密码			免费注册

[求助] 求VB语序