如何使用VBA将B4:D11区域的关联标题匹配填入F4:Q11新表格

实现逻辑 #

• 外层循环遍历4~11行的所有数据行
• 内层循环处理每行的B、C、D三个单元格，分别对应需要填充的标识A、B、C
• 自动将单元格内的中文月份转换为阿拉伯数字，无需手动维护月份映射关系
• 以当前行E列为基准，向右偏移对应月份的列数后填入对应标识

完整可运行代码 #

Sub 填充月份对应标题()
    Dim 行号 As Integer
    Dim 源列号 As Integer
    Dim 月份值 As Integer
    Dim 标识数组 As Variant
    
    ' 预定义B、C、D列对应的填充标识
    标识数组 = Array("A", "B", "C")
    
    ' 遍历4到11行的所有数据行
    For 行号 = 4 To 11
        ' 遍历B(2)、C(3)、D(4)三个源数据列
        For 源列号 = 2 To 4
            ' 跳过空的源单元格
            If Cells(行号, 源列号) <> "" Then
                ' 中文月份转数字，异常则跳过
                On Error Resume Next
                月份值 = Month(DateValue("1" & Cells(行号, 源列号) & "2024"))
                On Error GoTo 0
                
                ' 校验月份合法性后填充到目标位置
                If 月份值 >= 1 And 月份值 <= 12 Then
                    ' E列为第5列，偏移月份值对应列数后填入标识
                    Cells(行号, 5 + 月份值) = 标识数组(源列号 - 2)
                End If
            End If
        Next 源列号
    Next 行号
End Sub

使用方法 #

1. 打开目标Excel文件，按Alt+F11调出VBA编辑器
2. 右键点击当前工作簿，选择「插入」-「模块」
3. 将上述代码粘贴到模块编辑窗口
4. 按F5运行即可完成填充

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