如何用VBA循环分批拼接多行数据？修复起始行引用异常

核心问题分析 #

你的代码出现拼接范围错误，本质是两个问题：

1. 用于拼接内容的变量i没有在每次循环开始时清空，导致每次循环都会累加之前所有循环的内容，看起来像是startref没生效，实际是旧数据残留。
2. 循环末尾的重置逻辑存在错误，当A8超过100008时，错误地将A7设为808，这会打乱后续的起始行计算。

具体修复步骤 #

1. 清空拼接变量i：在每次循环读取范围前，重置i为空字符串，避免旧内容累加。
2. 修正重置逻辑：当起始行或结束行超过阈值时，同时重置A7和A8到初始值，保证下一轮循环的范围正确。

修复后的完整代码 #

Sub Mailer()
    Sheets("Data").Select
    Range("A5").Value = 0
    Range("A6").Value = 5
    Range("A7").Value = 9
    Range("A8").Value = 808
    Range("G2").Value = ""
       
    loopref = Sheets("Data").Range("A4").Value
    
    For x = 1 To loopref
        If Sheets("Data").Range("A5").Value < Sheets("Data").Range("A4").Value Then
            'autos
            howlong = Sheets("Data").Range("A6").Value
            startref = Sheets("Data").Range("A7").Value
            endref = Sheets("Data").Range("A8").Value
       
            Dim rng As Range
            Dim i As String
            Dim SourceRange As Range
            
            ' 关键修复：每次循环前清空拼接变量
            i = ""

            ''''''''''''''''''''''''''''''THIS LINE is ignoring the sequence
            Set SourceRange = ThisWorkbook.Sheets(1).Range("B" & startref & ":B" & endref)

            For Each rng In SourceRange
                i = i & rng & "; "
            Next rng
            Sheets("Data").Range("G2").Value = Trim(i)

            Sheets("Welcome").Select
            Dim wd As Object, editor As Object
            Dim doc As Object
            Dim oMail As MailItem
    
            ActiveSheet.Shapes.Range(Array("Object 1")).Select
            Selection.Verb Verb:=xlPrimary
            Set wd = GetObject(, "Word.Application")
            Set doc = ActiveDocument
            doc.Content.Copy
            doc.Close
            Set wd = Nothing

            Set OutApp = CreateObject("Outlook.Application")
            Set oMail = OutApp.CreateItem(olMailItem)
            With oMail
                .Display
                .BCC = Sheets("Data").Range("G2").Value
                .Subject = "Type your subject here"
                .BodyFormat = olFormatRichText
                Set editor = .GetInspector.WordEditor
                editor.Content.Paste
                .DeferredDeliveryTime = DateAdd("n", howlong, VBA.Now)
                .Send
            End With
    
            'adjust autos
            Sheets("Data").Range("A5").Value = Sheets("Data").Range("A5").Value + 1
            Sheets("Data").Range("A6").Value = Sheets("Data").Range("A6").Value + 60
            Sheets("Data").Range("A7").Value = Sheets("Data").Range("A7").Value + 800
            Sheets("Data").Range("A8").Value = Sheets("Data").Range("A8").Value + 800
            Sheets("Data").Range("G2").ClearContents
    
            'reset if exceeds
            If Sheets("Data").Range("A7").Value > 99209 Then
                Sheets("Data").Range("A7").Value = 9
                Sheets("Data").Range("A8").Value = 808
            End If
    
            If Sheets("Data").Range("A8").Value > 100008 Then
                Sheets("Data").Range("A7").Value = 9
                Sheets("Data").Range("A8").Value = 808
            End If

        End If
    Next x

    MsgBox "Sent to Outbox!"
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "Sent to outbox!"
End Sub

修复说明 #

• 在读取数据范围前添加i = ""，确保每次循环都从空字符串开始拼接，只保留当前循环范围内的内容。
• 修正重置逻辑，当A7或A8超过阈值时，同时重置为初始的9和808，保证下一轮循环的起始和结束行正确。

内容的提问来源于stack exchange，提问作者Fekra Business.Solutions