excel数据填充的vba代码

目标

• 给每一个户主都编上存编码，如果存在同名的，要求选择最近的存编码
• 注意：运行结果放入K列，所以K列是vba代码运行的结果，而非初始状态
  

vba代码（代码来源于deepseek）

Sub FillVillageCode()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim nameDict As Object
    Dim nameKey As String
    Dim villageCode As String
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
    Set nameDict = CreateObject("Scripting.Dictionary")
    
    ' 从最后一行开始向上遍历，填充字典
    For i = lastRow To 4 Step -1
        nameKey = ws.Cells(i, "J").Value
        villageCode = ws.Cells(i, "A").Value
        
        ' 如果字典中不存在该姓名，且村编码不为空，则添加到字典中
        If Not nameDict.exists(nameKey) And villageCode <> "" Then
            nameDict(nameKey) = villageCode
        End If
    Next i
    
    ' 再次遍历所有行，填充K列
    For i = 4 To lastRow
        nameKey = ws.Cells(i, "J").Value
        
        ' 如果字典中存在该姓名，则填充K列
        If nameDict.exists(nameKey) Then
            ws.Cells(i, "K").Value = nameDict(nameKey)
        End If
    Next i
End Sub

注释

代码说明：
第一次遍历（从下往上）：

从最后一行开始向上遍历，确保如果同一个姓名对应多个村编码，选择最近的村编码。

将每个姓名及其对应的村编码存储在字典 nameDict 中。

第二次遍历（从上往下）：

再次遍历所有行，检查字典中是否存在当前行的姓名。

如果存在，则将字典中的村编码填充到K列。

改进点：
确保所有相同姓名的行都填充相同的村编码：通过第二次遍历，确保所有相同姓名的行都使用字典中存储的村编码。

选择最近的村编码：通过从下往上遍历，确保字典中存储的是最近的村编码。

使用方法：
打开Excel文件，按 Alt + F11 打开VBA编辑器。

在VBA编辑器中，插入一个新模块（Insert > Module）。

将上述代码粘贴到模块中。

运行代码（按 F5 或点击 Run 按钮）。

运行后，K列将根据J列的姓名填充对应的村编码，且所有相同姓名的行都会填充相同的村编码（选择最近的村编码）。