Private Sub CommandButton匹配1_Click()
'判断参数不为空
Dim mc1 As Long
Dim mc2 As Long
With ThisWorkbook.Worksheets("操作界面")
If .Cells(2, "C").Value <> "" Then
mc1 = .Cells(2, "C").Value
Else
MsgBox "请输入表1匹配列"
Exit Sub
End If
If .Cells(6, "C").Value <> "" Then
mc2 = .Cells(6, "C").Value
Else
MsgBox "请输入表2匹配列"
Exit Sub
End If
End With
'清除匹配结果
With ThisWorkbook.Worksheets("匹配结果") '清除原列表数据
.UsedRange.ClearFormats
.UsedRange.ClearContents
End With
'获取表1表2最大列号行号
Dim cmax1 As Long
Dim cmax2 As Long
cmax1 = ThisWorkbook.Worksheets("表1").UsedRange.Cells(ThisWorkbook.Worksheets("表1").UsedRange.Count).Column
cmax2 = ThisWorkbook.Worksheets("表2").UsedRange.Cells(ThisWorkbook.Worksheets("表2").UsedRange.Count).Column
Dim rmax1 As Long
Dim rmax2 As Long
rmax1 = ThisWorkbook.Worksheets("表1").UsedRange.Cells(ThisWorkbook.Worksheets("表1").UsedRange.Count).Row
rmax2 = ThisWorkbook.Worksheets("表2").UsedRange.Cells(ThisWorkbook.Worksheets("表2").UsedRange.Count).Row
Dim i, j
Dim addrow As Long
addrow = 1
Dim matchtext1 As String
Dim matchtext2 As String
Dim a1 As Integer '判断循环时是否匹配成功
With ThisWorkbook.Worksheets("匹配结果") '清除原列表数据
For i = 1 To rmax2
a1 = 0
With ThisWorkbook.Worksheets("表2")
If .Cells(i, mc2) <> "" Then
matchtext2 = .Cells(i, mc2)
.Range(.Cells(i, 1), .Cells(i, cmax2)).Copy ThisWorkbook.Worksheets("匹配结果").Cells(addrow, 1)
With ThisWorkbook.Worksheets("表1")
For j = 1 To rmax1
If .Cells(j, mc1) <> "" Then
matchtext1 = .Cells(j, mc1)
If matchtext1 = matchtext2 Then
.Range(.Cells(j, 1), .Cells(j, cmax1)).Copy ThisWorkbook.Worksheets("匹配结果").Cells(addrow, cmax2 1)
a1 = 1
addrow = addrow 1
End If
End If
Next j
End With
If a1 = 0 Then
addrow = addrow 1
End If
End If
End With
Next i
End With
ThisWorkbook.Worksheets("匹配结果").Activate
End Sub
Private Sub CommandButton匹配2_Click()
'判断参数不为空
Dim mc1 As Long
Dim mc2 As Long
With ThisWorkbook.Worksheets("操作界面")
If .Cells(2, "C").Value <> "" Then
mc1 = .Cells(2, "C").Value
Else
MsgBox "请输入表1匹配列"
Exit Sub
End If
If .Cells(6, "C").Value <> "" Then
mc2 = .Cells(6, "C").Value
Else
MsgBox "请输入表2匹配列"
Exit Sub
End If
End With
'清除匹配结果
With ThisWorkbook.Worksheets("匹配结果") '清除原列表数据
.UsedRange.ClearFormats
.UsedRange.ClearContents
End With
'获取表1表2最大列号
Dim cmax1 As Long
Dim cmax2 As Long
cmax1 = ThisWorkbook.Worksheets("表1").UsedRange.Cells(ThisWorkbook.Worksheets("表1").UsedRange.Count).Column
cmax2 = ThisWorkbook.Worksheets("表2").UsedRange.Cells(ThisWorkbook.Worksheets("表2").UsedRange.Count).Column
Dim rmax1 As Long
Dim rmax2 As Long
rmax1 = ThisWorkbook.Worksheets("表1").UsedRange.Cells(ThisWorkbook.Worksheets("表1").UsedRange.Count).Row
rmax2 = ThisWorkbook.Worksheets("表2").UsedRange.Cells(ThisWorkbook.Worksheets("表2").UsedRange.Count).Row
Dim i, j
Dim addrow As Long
addrow = 1
Dim matchtext1 As String
Dim matchtext2 As String
Dim a1 As Integer '判断循环时是否匹配成功
With ThisWorkbook.Worksheets("匹配结果") '清除原列表数据
For i = 1 To rmax1
a1 = 0
With ThisWorkbook.Worksheets("表1")
If .Cells(i, mc1) <> "" Then
matchtext1 = .Cells(i, mc1)
.Range(.Cells(i, 1), .Cells(i, cmax1)).Copy ThisWorkbook.Worksheets("匹配结果").Cells(addrow, 1)
With ThisWorkbook.Worksheets("表2")
For j = 1 To rmax2
If .Cells(j, mc2) <> "" Then
matchtext2 = .Cells(j, mc2)
If matchtext1 = matchtext2 Then
.Range(.Cells(j, 1), .Cells(j, cmax2)).Copy ThisWorkbook.Worksheets("匹配结果").Cells(addrow, cmax1 1)
a1 = 1
addrow = addrow 1
End If
End If
Next j
End With
If a1 = 0 Then
addrow = addrow 1
End If
End If
End With
Next i
End With
ThisWorkbook.Worksheets("匹配结果").Activate
End Sub
实例36-根据输入值自动填充数据
Private Sub Worksheet_Change(ByVal Target As Range)
With ThisWorkbook.Worksheets("出库表")
If Target.Column = 3 And Target.Row >= 6 And Target.Row <= 10 Then
Dim row1 As Long
row1 = Target.Row
If Target <> "" Then
Dim i
For i = 1 To ThisWorkbook.Worksheets("商品列表").Cells(1000000, 1).End(xlUp).Row
If Target.Value = ThisWorkbook.Worksheets("商品列表").Cells(i, 1) Then
.Cells(row1, 4) = ThisWorkbook.Worksheets("商品列表").Cells(i, 2)
.Cells(row1, 5) = ThisWorkbook.Worksheets("商品列表").Cells(i, 4)
Exit Sub
End If
Next i
MsgBox "未找到对应商品"
Target = ""
.Cells(row1, 4) = ""
.Cells(row1, 5) = ""
Else
.Cells(row1, 4) = ""
.Cells(row1, 5) = ""
End If
End If
End With
End Sub
,