"录入正表"A列录入值时,自动匹配"匹配项"表A列唯一值,把"匹配项"表内容自动对应填入"录入正表"表里的VBA代码
时间: 2023-09-24 10:07:18 浏览: 40
以下是一个简单的VBA代码示例,实现了"录入正表"A列值自动匹配"匹配项"表A列唯一值,并把"匹配项"表内容自动对应填入"录入正表"表里。
```
Sub MatchAndFill()
Dim matchSheet As Worksheet
Dim inputSheet As Worksheet
Dim matchRange As Range
Dim inputRange As Range
Dim matchCol As Long
Dim inputCol As Long
Dim lastRow As Long
Dim matchDict As Object
Dim matchKey As Variant
Dim matchValue As Variant
Set matchSheet = ThisWorkbook.Worksheets("匹配项")
Set inputSheet = ThisWorkbook.Worksheets("录入正表")
matchCol = 1 ' 匹配项表的A列
inputCol = 1 ' 录入正表的A列
lastRow = inputSheet.Cells(inputSheet.Rows.Count, inputCol).End(xlUp).Row ' 获取录入正表最后一行
' 创建一个字典,用于存储匹配项表的内容
Set matchDict = CreateObject("Scripting.Dictionary")
Set matchRange = matchSheet.Range("A2:A" & matchSheet.Cells(matchSheet.Rows.Count, matchCol).End(xlUp).Row)
For Each matchKey In matchRange
If Not matchDict.Exists(matchKey.Value) Then
matchDict.Add matchKey.Value, matchKey.Row
End If
Next matchKey
' 遍历录入正表的A列,进行匹配
Set inputRange = inputSheet.Range("A2:A" & lastRow)
For Each cell In inputRange
matchValue = cell.Value
If matchDict.Exists(matchValue) Then
' 如果匹配到了,就把对应的匹配项表内容填入录入正表
inputSheet.Cells(cell.Row, inputCol + 1).Value = matchSheet.Cells(matchDict(matchValue), matchCol + 1).Value
End If
Next cell
End Sub
```
在这个示例代码中,我们假设"匹配项"表的唯一值是在A列里,需要匹配的是"录入正表"表的A列。我们首先创建了一个字典(matchDict),用于存储"匹配项"表的内容。然后遍历"录入正表"的A列,对每一个值进行匹配,如果匹配到了,就把对应的"匹配项"表内容填入"录入正表"表的B列。
你需要根据自己的具体需求,修改代码中的表名、列号等参数,才能使代码适用于你的数据。