Excel VBA 宏 - 在循环中连接

Posted 2023-02-24

【中文标题】Excel VBA 宏 - 在循环中连接

【英文标题】：Excel VBA Macro - Concatenating in a Loop

【发布时间】：2014-12-06 04:05:27

【问题描述】：

尝试创建一个宏，该宏将在电子表格中的每 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

如果我的描述不清楚，请道歉。这是我希望我的结果的剪辑。

任何帮助将不胜感激。

【问题讨论】：

您希望 串联 是一个公式还是只是串联的值？你想要它在 Column H 中吗？

【参考方案1】：

编辑：在标记线上添加了缺少的.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

【讨论】：

这个解决方案完全适合我的应用程序，并且在我目前的技能水平上是可以理解的。谢谢。

【参考方案2】：

我建议使用 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 运算符： http://msdn.microsoft.com/en-us/library/se0w9esz.aspx

或更完整：

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

【讨论】：

ActiveSheet.UsedRange.Count 返回UsedRange 中的单元格总数，而不仅仅是行数。当UsedRange 中的单元格数> 1048576 时，ActiveSheet.Range("A1:A" & ActiveSheet.UsedRange.Count) 将导致错误。在这种情况下，您想使用ActiveSheet.UsedRange.Rows.Count。

我将阅读有关 Mod 运算符的更多信息。我正在学习，你的代码加上资源将非常有价值。感谢您对我的 VBA 教育的指导。

【参考方案3】：

以下代码应提供您正在寻找的所需输出：

子 pInsert1000()

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   

结束子