2,503
社区成员




Option Explicit
Private arrData() As String
Private moSourSht As Worksheet
Private moDestSht As Worksheet
Private mlLastPnt As Long
Private Sub LoadData()
Dim objSht As Worksheet
Dim strTemp As String
Dim i&, w As Long
Set moSourSht = Sheets("Items")
w = WorksheetFunction.CountA(moSourSht.Range("V:V"))
ReDim arrData(w)
For i = 1& To w
strTemp = moSourSht.Cells(i, 22).Value
If ("" = strTemp) Then Exit For
arrData(i) = strTemp
Next
mlLastPnt = i - 1
End Sub
Private Function FillData(ByVal iRow As Long) As Long
Dim strTemp As String
Dim lRet As Long
Dim i As Long
strTemp = UCase$(Trim$(TextBox1.Text))
If ("" = strTemp) Then Exit Function ' 未输入有效数据
For i = 2 To mlLastPnt
If (strTemp = arrData(i)) Then Exit For
Next
If (i > mlLastPnt) Then
lRet = -1&
Else
moDestSht.Cells(iRow, 列号1).Value = strTemp '【件号/规格型号】
' 【物料属性】:
moDestSht.Cells(iRow, 列号2).Value = moSourSht.Cells(i, 20).Value
' 【物料状态】:
moDestSht.Cells(iRow, 列号3).Value = moSourSht.Cells(i, 21).Value
lRet = 0&
End If
FillData = lRet
End Function
Private Sub CommandButton1_Click()
Dim w As Long
' 如果当前活动工作表不是BOM表,不执行操作
If (Not ActiveSheet Is moDestSht) Then Exit Sub
' 选定的行属于“表头”区,不执行操作
w = ActiveCell.Row
If (w < 4) Then Exit Sub
' 准备自动填充数据
If (FillData(w)) Then MsgBox "未找到输入项目。", 64
End Sub
Private Sub UserForm_Initialize()
mlLastPnt = 0&
Call LoadData
Set moDestSht = Sheets("BOM")
End Sub
Private Sub UserForm_Terminate()
Set moSourSht = Nothing
Set moDestSht = Nothing
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 Then ''假如手动输入的列是第4列,自己根据需要修改
Dim Rng As Range
''从item表格D列中找到与target相同的单元格
Set Rng = Sheets("item").Columns("d:d").Find(What:=Target, LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
''如果能找到,则开始填充。这里用的负值表示指定单元格左侧第n个单元格,如果在右侧,用正值
Target.Offset(0, -1) = Rng.Offset(0, -1)
Target.Offset(0, -2) = Rng.Offset(0, -2)
'''.......
End If
End If
End Sub
...