Excel VBA：如何实现定位至下一个非空单元格以提取持卡人姓名

问题说明 #

我正在构建一个模板，用于从用户选择的Excel文件中提取所需输入。这些文件布局大致相同，但数据位置不固定，且存在随机列合并，无法通过硬编码指定数据位置。现有循环代码无法100%生效——当前逻辑是在第4行查找“Naam”后，用Offset提取持卡人姓名，但Offset的列数不固定，需要编写能自动偏移至下一个非空单元格的VBA代码。

现有代码 #

Sub KlantInformatie(wsTemplate, wsKlantprofiel)
    Dim i, j As Range
    
    '加载账户编号
    wsTemplate.Range("antAccountnummer").Value = wsKlantprofiel.Range("B2").Value
    
    '查找并加载CH和ECH的姓名
    For Each i In wsKlantprofiel.Range("C4:K4").Cells
    If i.Value = "Naam" Then
        With wsTemplate
            .Range("antNaamCH") = i.Offset(, 1).Value
            .Range("antNaamECH1") = i.Offset(, 6).Value
            .Range("antNaamECH2") = i.Offset(, 10).Value
            .Range("antNaamECH3") = i.Offset(, 11).Value
            .Range("antNaamECH4") = i.Offset(, 12).Value
            .Range("antNaamECH5") = i.Offset(, 13).Value
            .Range("antNaamECH6") = i.Offset(, 14).Value
            .Range("antNaamECH7") = i.Offset(, 15).Value
            .Range("antNaamECH8") = i.Offset(, 16).Value
            .Range("antNaamECH9") = i.Offset(, 17).Value
            .Range("antNaamECH10") = i.Offset(, 18).Value
        End With
    End If
Next i

修改后的解决方案 #

下面的代码会自动定位“Naam”所在单元格，然后依次找到后续的非空单元格，避免硬编码偏移量，适配列合并和位置变动的情况：

Sub KlantInformatie(wsTemplate As Worksheet, wsKlantprofiel As Worksheet)
    Dim naamCell As Range
    Dim currentCell As Range
    Dim echCounter As Integer
    
    '加载账户编号（保留原有逻辑）
    wsTemplate.Range("antAccountnummer").Value = wsKlantprofiel.Range("B2").Value
    
    '在第4行查找"Naam"，扩大查找范围避免漏找
    Set naamCell = wsKlantprofiel.Rows(4).Find(What:="Naam", LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not naamCell Is Nothing Then
        '获取CH姓名："Naam"右侧第一个非空单元格
        Set currentCell = naamCell.Offset(, 1)
        '跳过空单元格（处理合并列后的空值）
        Do While currentCell.Value = "" And Not currentCell Is Nothing
            Set currentCell = currentCell.Offset(, 1)
        Loop
        If Not currentCell Is Nothing Then
            wsTemplate.Range("antNaamCH").Value = currentCell.Value
        End If
        
        '获取后续ECH姓名，依次找下一个非空单元格
        echCounter = 1
        Set currentCell = currentCell.Offset(, 1)
        Do While echCounter <= 10 And Not currentCell Is Nothing
            '跳过空单元格
            Do While currentCell.Value = "" And Not currentCell Is Nothing
                Set currentCell = currentCell.Offset(, 1)
            Loop
            If Not currentCell Is Nothing Then
                wsTemplate.Range("antNaamECH" & echCounter).Value = currentCell.Value
                echCounter = echCounter + 1
                Set currentCell = currentCell.Offset(, 1)
            End If
        Loop
    End If
End Sub

关键改进点 #

• 使用Rows(4).Find替代循环查找，更高效且能覆盖更大范围
• 增加空单元格跳过逻辑，自动定位到下一个非空单元格，适配列合并导致的空值
• 用计数器动态匹配antNaamECH1到antNaamECH10，无需硬编码偏移量
• 增加对象存在性判断，避免空对象报错

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