Question

在Excel中，我需要为批量上传生成文件，其中包含1K，5K，10K和100K的行。所以我查看了VBA脚本。这是：

Private Sub CommandButton21_Click()

    ' This routing will copy rows based on the quantity to a new sheet.
    Dim rngSinglecell As Range
    Dim rngQuantityCells As Range
    Dim intCount As Integer

    ' Set this for the range where the Quantity column exists. This works only if there are no empty cells
    Set rngQuantityCells = Range("D1", Range("D1").End(xlDown))

    For Each rngSinglecell In rngQuantityCells
        ' Check if this cell actually contains a number
        If IsNumeric(rngSinglecell.Value) Then
            ' Check if the number is greater than 0
            If rngSinglecell.Value > 0 Then
                ' Copy this row as many times as .value cut out rngSinglecell DOT Value
                For intCount = 1 To 1000
                    ' Copy the row into the next emtpy row in sheet2
                    Range(rngSinglecell.Address).EntireRow.Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    ' The above line finds the next empty row.

                Next
            End If
        End If
    Next

End Sub

但我想做的是将一行数据从A15复制到Y15，然后将其粘贴到工作表中，以便我可以将其复制粘贴回来原始工作表（用于iProcurement中的批量上传）。

出于某种原因，我的行只被复制了两次，即使我将intcount更改为以下内容：

For intCount = 1 To 1000

任何提示表示赞赏，谢谢！

Answer 1

据我所知，你正试图这样做 -

Sub test()
    ' This routing will copy rows based on the quantity to a new sheet.

    Dim lastrow As Integer
    lastrow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row

    ' Set this for the range where the Quantity column exists. This works only if there are no empty cells

    Dim destlastrow As Integer
    destlastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
    ' The above line finds the next empty row.
    For i = 1 To lastrow
        ' Check if this cell actually contains a number
        If IsNumeric(Cells(i, 4)) Then
            ' Check if the number is greater than 0
            If Cells(i, 4) > 0 Then
                ' Copy this row as many times as .value cut out rngSinglecell DOT Value
                For j = 1 To Cells(i, 4).Value
                    ' Copy the row into the next emtpy row in sheet2
                    Cells(i, 4).EntireRow.Copy Destination:=Sheets("Sheet2").Cells(destlastrow, 1)
                    destlastrow = destlastrow + 1

                Next
            End If
        End If
    Next

End Sub

在Excel中，如何生成一行X次？

1 个答案: