Excel VBA：Do Until循环偏移值是否最优及ListBox项覆盖问题求助

一、先搞定ListBox只存第一个值的bug #

看你写的ListBox代码，有两个明显的问题：

• 变量i根本没初始化（默认是0，但逻辑完全不对）；
• 列表项的索引用反了——你写的.List(0, i)是在第0行第i列写值，但我们要的是每次新增一行，然后在新行里填两列内容。

先把ListBox的代码改成这样（记得先在用户窗体设计器里把ListBox1的ColumnCount设为2，这样才能显示两列）：

With Me.ListBox1
    .AddItem ' 先添加一行空项
    ' 给刚添加的那行第1列（索引0）填ttxt的值
    .List(.ListCount - 1, 0) = Me.ttxt
    ' 给同一行第2列（索引1）填合并后的atxt和xtxt
    .List(.ListCount - 1, 1) = Me.atxt & ", " & Me.xtxt
End With

解释下：.ListCount - 1就是刚新增的那一行的索引（因为ListBox的行从0开始数，加完一行后总数+1，最后一行的索引就是总数减一）。这样每次点add按钮，ListBox就会新增一行，再也不会覆盖之前的内容了。

二、Do Until循环是不是最优方案？ #

答案是：真不是。你的循环逻辑是一直往右挪单元格，直到找到空的，但其实Excel有更高效的方法直接定位到目标位置，根本不用循环。

为什么循环不好？ #

循环要逐个单元格检查，要是以后数据列很多，会拖慢运行速度，而且代码绕来绕去容易出错。我们可以直接用Excel内置的End(xlToLeft)找到当前行最后一个非空的单元格，然后直接偏移2列就行，代码更简洁还快。

优化后的工作表写入代码 #

我帮你重新梳理了逻辑（顺便去掉了容易出问题的Activate，直接引用工作表对象更稳定）：

Private Sub addbtn_Click()
    ' 直接引用Sheet1，不用Activate
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")
    
    ' 获取目标行：F1向上找最后非空行，再往下偏移2行
    Dim targetRow As Long
    targetRow = ws.Range("F1").End(xlUp).Offset(2, 0).Row
    
    ' 找目标行最后一个非空的列
    Dim lastCol As Long
    lastCol = ws.Cells(targetRow, ws.Columns.Count).End(xlToLeft).Column
    
    Dim tCell As Range, rCell As Range
    ' 判断该行是不是空的，或者还没开始写入数据
    If lastCol < 6 Or ws.Cells(targetRow, lastCol) = "" Then
        ' 从F列和G列开始写
        Set tCell = ws.Cells(targetRow, "F")
        Set rCell = ws.Cells(targetRow, "G")
    Else
        ' 找到最后一个t列（F、H、J...偶数列），然后往右挪2列
        If lastCol Mod 2 = 0 Then
            Set tCell = ws.Cells(targetRow, lastCol).Offset(0, 2)
        Else
            Set tCell = ws.Cells(targetRow, lastCol - 1).Offset(0, 2)
        End If
        Set rCell = tCell.Offset(0, 1) ' r列在t列右边1列
    End If
    
    ' 写入数据
    tCell.Value = Me.atxt & ", " & Me.xtxt
    rCell.Value = Me.ttxt
    
    ' 处理ListBox（用上面修改好的代码）
    With Me.ListBox1
        .ColumnCount = 2 ' 确保显示2列
        .AddItem
        .List(.ListCount - 1, 0) = Me.ttxt
        .List(.ListCount - 1, 1) = Me.atxt & ", " & Me.xtxt
    End With
    
    ' 清空表单输入框
    Me.ttxt = ""
    Me.atxt = ""
    Me.xtxt = ""
End Sub

这样改完，不仅解决了ListBox的问题，工作表写入的逻辑也更清晰高效，还避免了Select/Activate带来的潜在bug。

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