vba - Excel VBA - 遍历范围并复制每个单元格 9 次

Question

我有一个数据如下的电子表格：

   G H I J K L M N O P Q R S T U V W X Y Z AA AB AC AD ... etc. 
2  1
3  2
4  4 8 12 16 20 24 28 32 36 40
5  8 16 24 32 40

也就是说，G2 = 1，G3 = 1 ... M4 = 28 等等...

我需要帮助的是通过这个范围，这可能是动态的，因为人们在需要更改内容时将数据输入到这个范围内。我需要遍历行和列，对于每个具有值的单元格，我需要将其粘贴到 D 列中的不同工作表中，每个单元格 9 次。

也就是说，在第二张纸上，上面的数据会变成：

Column
  D
  1
  1
  1
  1
  1
  1
  1
  1
  1
  2
  2
  2
  2
  2
  2
  2
  2
  2
  4
  4
  .. etc... 

如何遍历每一行，然后是每一列，然后对于每个具有值的单元格，将其复制 9 次到另一张纸上的 D 列中，然后对于具有值的下一个单元格，将其复制到粘贴的内容下方和很快？

标签： vbaexcelloops

Answer 1

试试下面的。它假设您要逐列遍历该列中所有填充的单元格，重复该值 9 次。

Option Explicit

Public Sub OutputRepeatedValues()

    Dim arr()
    Const DELIMITER As String = ","
    Const NUMOFTIMES As Long = 9
    With ThisWorkbook.Worksheets("Sheet1")
        arr = .Range(.Range("G2"), .Range("G2").SpecialCells(xlLastCell)).Value
    End With

    Dim i As Long, j As Long, output As String

    For i = LBound(arr, 2) To UBound(arr, 2)     '<== iterate rows with a column, column by column
        For j = LBound(arr, 1) To UBound(arr, 1)
            If Not IsEmpty(arr(j, i)) Then output = output & Replicate(arr(j, i), NUMOFTIMES, DELIMITER)
        Next j
    Next i

    output = Left$(output, Len(output) - 1)

    ThisWorkbook.Worksheets("Sheet2").Range("B1").Resize(Len(output), 1) = Application.WorksheetFunction.Transpose(Split(output, DELIMITER))

End Sub

'Adapted from @this  https://codereview.stackexchange.com/questions/159080/string-repeat-function-in-vba?utm_medium=organic&utm_source=google_rich_qa&utm_campaign=google_rich_qa
Public Function Replicate(ByVal RepeatString As String, ByVal NUMOFTIMES As Long, Optional ByVal DELIMITER As String = ",")
    Dim s As String, c As Long, l As Long, i As Long
    l = Len(RepeatString) + 1
    c = l * NUMOFTIMES
    s = Space$(c)

    For i = 1 To c Step l
        Mid(s, i, l) = RepeatString & DELIMITER
    Next i

    Replicate = s
End Function

笔记：

1. 测试数据集布局如下图

2. 我假设您想要处理任何数据丢失或正确的数据G2，包括G2. 为了做到这一点，我SpecialCells(xlLastCell)用来查找最后使用的单元格。然后我用 构造一个范围.Range(.Range("G2"), .Range("G2").SpecialCells(xlLastCell))，在这种情况下是$G$2:$Q$5，并将其读入一个数组。
3. 假设您确实在移动到下一列之前使用一列迭代行，如您的问题中所述。我连接填充的单元格值，同时调用 4) 中描述的 Replicate 函数。
4. 我已经通过@this劫持并改编了一个高性能函数来处理字符串重复。我为分隔符添加了一个可选参数。添加了一个分隔符，因此我可以稍后将其拆分以将结果写入目标工作表中的各个单元格。
5. 我在分隔符上拆分了字符串 , output，这创建了一个重复值的数组，我将其转置，因此我可以写出目标工作表中的一列。

示例输出：

编辑：

相反，如果您想循环行，然后是列，请与上述函数一起使用以下内容：

Public Sub OutputRepeatedValues()

    Dim arr()
    Const DELIMITER As String = ","
    Const NUMOFTIMES As Long = 9
    With ThisWorkbook.Worksheets("Sheet1")
        arr = .Range(.Range("G2"), .Range("G2").SpecialCells(xlLastCell)).Value
    End With

    Dim i As Long, j As Long, output As String

    For i = LBound(arr, 1) To UBound(arr, 1)     '<== iterate rows with a column, column by column
        For j = LBound(arr, 2) To UBound(arr, 2)
            If Not IsEmpty(arr(i, j)) Then output = output & Replicate(arr(i, j), NUMOFTIMES, DELIMITER)
        Next j
    Next i

    output = Left$(output, Len(output) - 1)

    ThisWorkbook.Worksheets("Sheet2").Range("B1").Resize(Len(output), 1) = Application.WorksheetFunction.Transpose(Split(output, DELIMITER))

End Sub