首页 文章

Excel VBA宏 - 循环连接

提问于
浏览
3

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

如果我的描述不清楚,请道歉 . 这是我想要的结果的剪辑 .

Clip

任何帮助,将不胜感激 .

3 回答

  • 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
    
  • 0

    我建议使用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
    
  • 3

    下面的代码应该提供您正在寻找的所需输出:

    Sub 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
    

    结束子

相关问题