如何用VBA实现多选Listbox时为每个选中项生成对应数据行

问题场景 #

我有一个包含多个文本框和一个可多选月份的Listbox的表单，需求如下：

• 选中多个月份时，为每个选中项在已有数据的最后一行下方生成新行，填入文本框数据与对应月份（比如选一月、二月就生成两行）
• A列需显示当前年份+月份数字格式（如202201代表一月、202202代表二月）

当前代码只能生成一行数据，现有获取最后行的代码：

last = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 1

现有Listbox处理代码：

Dim i As Integer
With Exceptions.Listmonths

For i = 0 To .ListCount - 1
    If .Selected(i) Then
        
        If Cells(last, 2).Value = "" Then
            ActiveSheet.Cells(last, 2).Value = .List(i)
        Else
            ActiveSheet.Cells(last, 2).Value = .List(i)
        End If
        
    Else
        
    End If
    
Next i

End With

修改后的VBA代码 #

Dim i As Integer
Dim currentYear As String
Dim lastRow As Long

' 获取4位格式的当前年份
currentYear = Format(Date, "YYYY")

With Exceptions.Listmonths
    For i = 0 To .ListCount - 1
        If .Selected(i) Then
            ' 每次循环重新计算最后行位置，确保写入新行
            lastRow = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 1
            
            ' 填充A列：年份+月份数字（适配中文月份选项，若Listbox存数字1-12可简化）
            Select Case .List(i)
                Case "一月": ActiveSheet.Cells(lastRow, 1).Value = currentYear & "01"
                Case "二月": ActiveSheet.Cells(lastRow, 1).Value = currentYear & "02"
                Case "三月": ActiveSheet.Cells(lastRow, 1).Value = currentYear & "03"
                Case "四月": ActiveSheet.Cells(lastRow, 1).Value = currentYear & "04"
                Case "五月": ActiveSheet.Cells(lastRow, 1).Value = currentYear & "05"
                Case "六月": ActiveSheet.Cells(lastRow, 1).Value = currentYear & "06"
                Case "七月": ActiveSheet.Cells(lastRow, 1).Value = currentYear & "07"
                Case "八月": ActiveSheet.Cells(lastRow, 1).Value = currentYear & "08"
                Case "九月": ActiveSheet.Cells(lastRow, 1).Value = currentYear & "09"
                Case "十月": ActiveSheet.Cells(lastRow, 1).Value = currentYear & "10"
                Case "十一月": ActiveSheet.Cells(lastRow, 1).Value = currentYear & "11"
                Case "十二月": ActiveSheet.Cells(lastRow, 1).Value = currentYear & "12"
            End Select
            
            ' 填充B列选中的月份文本
            ActiveSheet.Cells(lastRow, 2).Value = .List(i)
            
            ' 填充其他文本框数据（替换成你的实际控件名）
            ActiveSheet.Cells(lastRow, 3).Value = Exceptions.TextBox1.Value
            ' ActiveSheet.Cells(lastRow, 4).Value = Exceptions.TextBox2.Value
            ' 按需添加更多文本框的赋值
        End If
    Next i
End With

关键改动说明 #

• 动态获取最后行：原来的last仅初始化一次，导致所有选中项覆盖同一行。现在每次循环重新计算lastRow，保证每选中一个月份就生成新行。
• A列格式适配：通过Format(Date, "YYYY")获取当前年份，搭配月份数字拼接成要求的格式。如果Listbox存储的是1-12的数字，可直接用currentYear & Format(.List(i), "00")简化代码。
• 移除冗余判断：原代码中判断单元格是否为空的逻辑完全多余，直接赋值即可。

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