Excel VBA宏执行无报错但未更新City列问题求助

核心问题分析 #

原代码存在以下几个关键问题导致未生效：

• 列索引不匹配：通过Lugar表的H列计算最后一行，但循环检查的是A列（地址列），若实际地址不在A列、City列不在B列，会直接导致匹配或写入错误。
• 最后一行计算逻辑矛盾：用H列的行数遍历A列数据，若H列数据行数少于A列，会遗漏部分地址行；若H列无数据，仅会检查第一行。
• 无空值防护：Siudad表中若存在空单元格，会导致所有行的City列被清空。
• 匹配覆盖问题：先遍历城市再遍历地址，若一个地址包含多个城市名称，后匹配的城市会覆盖之前的结果，不符合预期。

修正后的代码 #

Sub UpdateCityNames()
    Dim wsLugar As Worksheet
    Dim wsSiudad As Worksheet
    Dim lastRowLugar As Long
    Dim lastRowSiudad As Long
    Dim i As Long, j As Long
    Dim townOrCityName As String
    Dim addressCol As String, cityCol As String ' 定义地址列、City列的列标
    
    ' 请根据实际表格结构修改以下列标
    addressCol = "H" ' 地址所在列（对应原代码中lastRowLugar的计算列）
    cityCol = "B"    ' City列的位置
    
    ' 绑定工作表
    Set wsLugar = ThisWorkbook.Sheets("Lugar")
    Set wsSiudad = ThisWorkbook.Sheets("Siudad")
    
    ' 正确计算各表的最后一行：用地址列计算Lugar表数据范围
    lastRowLugar = wsLugar.Cells(wsLugar.Rows.Count, addressCol).End(xlUp).Row
    lastRowSiudad = wsSiudad.Cells(wsSiudad.Rows.Count, "A").End(xlUp).Row
    
    ' 清空City列旧数据，避免残留值干扰
    wsLugar.Range(cityCol & "1:" & cityCol & lastRowLugar).ClearContents
    
    ' 遍历所有地址行
    For j = 1 To lastRowLugar
        Dim addressStr As String
        addressStr = wsLugar.Cells(j, addressCol).Value
        ' 跳过空地址行
        If addressStr = "" Then GoTo NextRow
        
        ' 遍历城市列表，找到第一个匹配项后退出
        For i = 1 To lastRowSiudad
            townOrCityName = wsSiudad.Cells(i, 1).Value
            ' 跳过空城市名
            If townOrCityName = "" Then GoTo NextCity
            
            ' 不区分大小写检查地址是否包含城市名
            If InStr(1, addressStr, townOrCityName, vbTextCompare) > 0 Then
                wsLugar.Cells(j, cityCol).Value = townOrCityName
                Exit For ' 找到匹配后停止内层循环，避免覆盖
            End If
NextCity:
        Next i
NextRow:
    Next j
End Sub

关键修改说明 #

1. 新增可配置的列变量，无需修改代码核心逻辑即可适配不同表格结构。
2. 用地址列计算Lugar表的最后一行，确保遍历所有有效地址数据。
3. 增加空值过滤，跳过空地址和空城市名，避免无效匹配。
4. 调整循环顺序，找到第一个匹配城市后立即退出内层循环，防止后续城市覆盖正确结果（若需最长匹配，可扩展为记录最长匹配的城市名再写入）。

内容的提问来源于stack exchange，提问作者Jonas Ancheta