Excel VBA宏-在循环中连接

尝试创建一个宏，该宏将在电子表格中每隔1000行插入一行，并将一列中前1000行的串联插入到另一列中该1000行的单个单元格中

我使用此代码每1000行插入一行：

Sub Insert1000()
    Dim rng As Range

    Set rng = Range("A2")
    While rng.Value <> ""
        rng.Offset(1000).EntireRow.Insert

        'code insert csv of 1000 previous rows into a single cell

        Set rng = rng.Offset(1001)
    Wend
End Sub

Sub Insert1000（）
变暗rng As范围
设置rng=范围（“A2”）
而rng.Value“”
发动机偏移量（1000）.EntireRow.Insert
'代码将前1000行的csv插入单个单元格
设置rng=rng偏移量（1001）
温德
端接头

如果我的描述不清楚，请道歉。下面是一个剪辑，我希望我的结果是什么

---

任何帮助都将不胜感激。

我建议使用Mod操作员：

Dim x

For Each x In ActiveSheet.Range("A1:A" & ActiveSheet.UsedRange.Rows.Count)
    If x.Row Mod 1000 = 0 Then
        x.EntireRow.Insert
    End If
Next x

请在此处阅读有关Mod运算符的信息：

或者更全面地说：

Dim x, y, outputText As String

For Each x In ActiveSheet.Range("A1:A" & ActiveSheet.UsedRange.Rows.Count)
    outputText = outputText & x.Value
    If x.Row Mod 1000 = 0 Then
        x.EntireRow.Insert
        x.Value = outputText
        outputText = ""
    End If
Next x

---

编辑：在标记行上添加缺少的

.EntireRow

Sub InsertCSV()
    Const BLOCK_SIZE As Long = 1000
    Dim rng As Range, num

    Set rng = Range("A2").Resize(BLOCK_SIZE)
    num = Application.CountA(rng)

    Do While num > 0
        rng.Cells(BLOCK_SIZE + 1).EntireRow.Insert
        With rng.Cells(BLOCK_SIZE + 1).EntireRow '<<edited
        .Cells(1, "H").Value = Join(Application.Transpose(rng.Value), ",")
        .Cells(1, "I").Value = Join(Application.Transpose(rng.Offset(0, 1).Value), ",")
        End With
        Set rng = rng.Offset(BLOCK_SIZE + 1)
        num = Application.CountA(rng)
    Loop

End Sub

Sub InsertCSV（）
常量块大小（长度=1000）
Dim rng作为范围，num
设置rng=范围（“A2”）。调整大小（块大小）
num=Application.CountA（rng）
当num>0时执行此操作
rng.单元格（块大小+1）.EntireRow.Insert
对于rng.Cells（BLOCK_SIZE+1）。EntireRow'以下代码应提供所需的输出：

副销SERT1000（）

Dim lngLoop尽可能长
总长度等于
暗lngCounter尽可能长
暗格兰奇山脉
作为字符串的Dim strConcatACol
作为字符串的Dim strConcatBCol
设置rngRange=Cells.Find（“*”，Cells（1，1），xlFormulas，xlWhole，xlByRows，xlPrevious）
如果不是的话，田庄什么都不是
lngTotal=rngRange.Row
其他的
lngTotal=0
如果结束
lngCounter=0
lngLoop=1
而lngLoop

End Sub
您希望连接是一个公式还是仅仅是连接的值？您希望它位于H列吗？
ActiveSheet.UsedRange.Count
返回
UsedRange
中的单元格总数，而不仅仅是行数。当
UsedRange
中的单元格数>1048576时，
ActiveSheet.Range（“A1:A”&ActiveSheet.UsedRange.Count）
将导致错误。在本例中，您希望使用
ActiveSheet.UsedRange.Rows.Count
。我将阅读更多有关Mod运算符的信息。我正在学习，您的代码与资源的结合将是非常有价值的。感谢您对我的VBA教育的指导。这个解决方案完全适合我的应用程序，以我目前的技能水平是可以理解的。非常感谢。
Dim lngLoop             As Long
Dim lngTotal            As Long
Dim lngCounter          As Long
Dim rngRange            As Range
Dim strConcatACol       As String
Dim strConcatBCol       As String

Set rngRange = Cells.Find("*", Cells(1, 1), xlFormulas, xlWhole, xlByRows, xlPrevious)
If Not rngRange Is Nothing Then
    lngTotal = rngRange.Row
Else
    lngTotal = 0
End If

lngCounter = 0
lngLoop = 1
While lngLoop < lngTotal

    lngCounter = lngCounter + 1
    If lngCounter = 1 Then
        strConcatACol = Cells(lngLoop, 1)
        strConcatBCol = Cells(lngLoop, 2)
    Else
        strConcatACol = strConcatACol & ", " & Cells(lngLoop, 1)
        strConcatBCol = strConcatBCol & ", " & Cells(lngLoop, 2)
    End If
    If lngCounter = 1000 Then
        Rows(lngLoop + 1).EntireRow.Insert
        Cells(lngLoop + 1, 8) = strConcatACol
        Cells(lngLoop + 1, 9) = strConcatBCol
        lngLoop = lngLoop + 1
        lngTotal = lngTotal + 1
        lngCounter = 0
    End If
    lngLoop = lngLoop + 1
Wend

Set rngRange = Nothing