基于另一列的值向指定列粘贴对应内容的宏开发需求

实现代码 #

Sub FillGreetings()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    ' 绑定当前活动工作表，也可指定具体表名如Sheets("人员列表")
    Set ws = ActiveSheet
    
    ' 获取Country列（假设为B列）的最后一行数据行号
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' 从第2行开始遍历（跳过表头行）
    For i = 2 To lastRow
        Select Case UCase(ws.Cells(i, "B").Value)
            Case "GERMANY"
                ws.Cells(i, "C").Value = "Hallo, guten tag"
            Case "SPAIN"
                ws.Cells(i, "C").Value = "Hola"
            ' 如需新增其他国家规则，直接添加Case即可
            ' Case "FRANCE"
            '     ws.Cells(i, "C").Value = "Bonjour"
            Case Else
                ' 其他国家可留空或设置默认问候语，取消注释即可启用
                ' ws.Cells(i, "C").Value = "Hello"
        End Select
    Next i
End Sub

使用步骤 #

1. 假设你的表格结构：第1行是表头，姓名在A列，Country在B列，Greetings在C列。如果列位置不同，把代码里的"B"（Country列）和"C"（Greetings列）改成对应列字母或数字（比如第5列用5代替"E"）。
2. 打开Excel文件，按下Alt + F11打开VBA编辑器。
3. 右键点击左侧工作簿名称，选择插入→模块，粘贴上述代码。
4. 返回Excel界面，按下Alt + F8，选中FillGreetings宏，点击执行即可自动填充。

代码说明 #

• UCase()：将Country列内容转大写，避免大小写差异导致匹配失败（比如输入"germany"也能识别）。
• lastRow：自动获取数据最后一行，无需手动指定行数，适配不同长度的列表。
• Select Case：比多段If判断更清晰，后续扩展其他国家问候语只需新增Case分支。

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