excel两个表格数据匹配自动填充

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

Private Sub Worksheet_Change(ByVal Target As Range)

With ThisWorkbook.Worksheets("出库表")

If Target.Column = 3 And Target.Row >= 6 And Target.Row