使用Offset函数的VBA代码插入多余行问题求助

核心问题 #

1. 循环条件逻辑错误：原代码Loop While x > 0 Or x < 24用Or导致只要输入的x小于24（含1-23）就会持续弹出输入框，误操作重复输入就会插入多余行。
2. 插入行的写法冗余易出错：原代码通过复杂的Range偏移计算插入行，后续循环时容易因单元格位置变化产生意外的行数插入。
3. 冗余的行高设置：每次都设置第3到268行的行高，属于没必要的全范围操作，只需针对新插入的行设置即可。

修正后的代码 #

Sub InsertRows()
    Dim x As Integer
    Dim y As Integer
    Dim insertRange As Range
    
    Do
        ' 获取用户输入的每托行数
        x = Application.InputBox("每托的行数", "每托行数", Type:=1)
        ' 用户点击取消则直接退出
        If x = 0 Then Exit Sub
        
        ' 获取托号
        y = Application.InputBox("托号", "请输入托号", Type:=1)
        
        ' 精准插入x行到第3行上方
        Set insertRange = Rows("3:3").Resize(x)
        insertRange.Insert Shift:=xlDown
        
        ' 仅给新插入的行设置行高
        insertRange.RowHeight = 15.75
        
        ' 写入托号并合并对应列的单元格
        Range("A3").Value = y
        ' 循环合并A到H列的x行单元格，简化重复代码
        Dim col As Integer
        For col = 1 To 8
            Range(Cells(3, col), Cells(3 + x - 1, col)).Merge
        Next col
        
    ' 修正循环条件：仅当x在1-23之间时继续循环
    Loop While x > 0 And x < 24
End Sub

关键修改点 #

• 循环条件将Or改为And，只有输入的x在1到23之间时才会继续弹出输入框，避免误操作导致重复插入。
• 用Rows("3:3").Resize(x)直接指定插入行数，写法简洁可靠，避免偏移计算错误。
• 用循环合并A到H列单元格，减少重复代码，提升可维护性。
• 仅对新插入的行设置行高，去掉不必要的全范围操作。

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