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 раз для каждой ячейки.

То есть на 2-м листе приведенные выше данные будут выглядеть так:

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 на другом листе, а затем для следующей ячейки со значением скопируйте НИЖЕ что был вставлен и так далее?

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. Предположим, что вы действительно перебираете строки со столбцом, прежде чем переходить к следующему столбцу, как описано в вашем вопросе. Я объединяю значения заполненных ячеек, одновременно вызывая функцию Replicate, описанную в 4).
4. Я похитил и адаптировал перманентную функцию с помощью @ this , чтобы обработать повтор строки. Я добавил необязательный аргумент для разделителя. Добавлен разделитель, так что я могу позже разделить его, чтобы выписать результаты в отдельные ячейки в целевом рабочем листе.
5. Я разделяю строку, output, по разделителю, это создает массив повторяющихся значений, которые я транспонирую, чтобы я мог записать их в столбец на целевом листе.

Пример вывода:

Edit:

Если вместо этого вы хотите зациклить строки, а затем столбцы, используйте с вышеуказанной функцией следующее:

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

Answer 2

Мой 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 ячеек.