Question

我正在尝试构建以下代码，以便计算一行中有多少个单元格有数据。根据计数，我需要使用与计数相同的数字复制单元格。例如，如果计数为3，那么我需要将数据复制3次。

n =工作表（＆＃34; Sheet1＆＃34;）。范围（＆＃34; C2：P2＆＃34;）。Cells.SpecialCells（xlCellTypeConstants）.Count

要复制三次的数据将位于Sheet1 A2：B2中，需要复制到Sheet2 A2：B2 我需要继续这个，直到我在sheet1中找到一个空行非常感谢您的帮助或帮助。

Answer 1

要执行此操作，您需要遍历包含Sheet1中数据的每一行。然后，您需要计算C:P到该行的填充列数。然后将其粘贴到Sheet2中多次。

这看起来像是：

Sub duplicateData()
    Dim rngReadRows As Range
    Dim rngWrite As Range
    Dim rngCell As Range
    Dim timesToPaste As Integer
    Dim pasteCount As Integer
    Dim arrMonth() As Date


    'Set up the rows that we will read from
    Set rngReadRows = Sheet1.Range("A2:A10").Rows

    'Set up the first cell/row we will write to
    Set rngWrite = Sheet2.Range("A2")



    'Now loop through each row from which we will read
    For Each rngReadRow In rngReadRows.Rows

        'figure out how many times we need to paste this thing
        timesToPaste = Application.WorksheetFunction.CountA(rngReadRow.Offset(, 2).Resize(1, 13))

        'redim the date array to the size we need
        ReDim arrMonth(1 To timesToPaste)

        'Fill the array
        i = 1
        For Each rngCell In Sheet1.Range("C1:P1").Cells
            If rngReadRow.Cells(1, rngCell.Column).Value <> "" Then
                arrMonth(i) = rngCell.Value
                i = i + 1
            End If

        Next rngCell

        'Loop however many number of times
        For pasteCount = 1 To timesToPaste

            'Paste it
            rngReadRow.Resize(1, 2).Copy Destination:=rngWrite

            'Get the date
            rngWrite.Resize(1, 1).Offset(, 2).Value = arrMonth(pasteCount)

            'Increment to next row
            Set rngWrite = rngWrite.Offset(1)
        Next pasteCount
    Next rngReadRow
End Sub

如何根据范围内的计数复制数据？

1 个答案: