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

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

   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列，然后针对下一个有值的单元格，将其复制到粘贴的内容下面，依此类推？

我的vba已经生锈了，但我认为这段（伪）代码可能会对您有所帮助

def last_row as integer, last_col as integer, row as integer, col as integer, target as integer
'I like something like this to get the value but you have to know the largest column: Cells(Rows.Count, col_to_check).End(xlUp).Row

target = 1

for col = 7 to last_col '7 = G
  for row = 2 to last_row
    if(Not IsEmpty(Cells(row,col)) then
      Range(Cells(target*9-8, 4), Cells(target*9, 4))= Cells(row,col)
      target = target +1
    end
  next row
next col

---

这将遍历所有列和行，检查是否存在值，并将其复制到9个单元格范围，然后迭代目标，使其指向下一个9个单元格。

请尝试以下操作。它假设您希望逐列遍历该列中所有填充的单元格，并将该值重复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

---

我认为对你有效的方法是将你的数据复制到另一个隐藏的表中。然后，您将添加一个按钮来确认单元格中的更改。该按钮将启动一个宏，该宏使用双循环，并将每个单元格与第二张工作表上的单元格进行比较。在一个不同的事件中，它会加上你的9倍1/2/3。。。并更改第二张图纸中的值。这是我理解问题的方式，但我不确定这是否正确。谢谢！！！这是因为它遍历所有的行/列，但输出与我想要的不同。代码沿着G行向下粘贴9次值，然后进入H列（h2、h3等），粘贴这9次，以此类推。我需要它穿过每一行，从第2行开始，如果G、H和I列中有数字，我希望它将G2粘贴9次到另一张纸上，然后是H2，然后是I2，等等，直到没有值，然后转到第3行，做同样的事情：找到所有有值的单元格，然后一次一列（G3、H3、I3、J3等等）将这些值转换为一列。将循环循环循环。请查看编辑并让我知道是否有效。QHarr，你是个天才！谢谢你！我目前正在研究您的代码，以便能够完全理解它的工作原理。谢谢你帮我省去了这么多头痛！别担心。如果你需要澄清什么，请告诉我。

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