Копирование значений таблицы в формат сетки

Question

Я создал пользовательскую форму, где пользователь будет вводить желаемый размер сетки.Таблица автоматически заполняется, чтобы соответствовать их вводу.Формат состоит из буквенной ссылки для оси x и номера для оси y (точно такой же параметр настроен, т. Е. Ячейка 1 является ссылкой A-1).

Затем они вставят по три показания в каждую строку, где по среднему значению заполняется.Я пытаюсь создать способ скопировать эти результаты в фактический формат сетки.

Прикрепили две фотографии, чтобы уточнить, как это выглядит в настоящее время в формате таблицы и желаемой компоновке сетки.

Я пытался поиграть с различными циклами ... Одна идея, которую я пытался настроить, - это переменная, назначенная функции 'Count'.Затем он посчитал бы число единиц в столбце F. Затем попытался настроить цикл для копирования и вставки (транспонирования) в сетку, задав диапазон копирования как (i + Count.Value).

Однако я не смог найти формулу для цикла, чтобы перезапустить копирование / вставку в ячейки, ранее не выбранные.то есть, используя приведенную выше формулу, первый диапазон будет F3: F7, второй F4: F8, хотя на самом деле мне нужно, чтобы он был F8: F12.

Примеры кода

`The loop I setup to take the user input values for the grid size to put it in the table`
For i = 1 To Axial_Data_Points
            For j = 1 To Circum_Data_Points
                If i <= 26 Then
                    Worksheets("Data Entry").Cells(j + 2 + (i - 1) * Circum_Data_Points_Box, 5).Value = Chr(i + 64)
                    Worksheets("Data Entry").Cells(j + 2 + (i - 1) * Circum_Data_Points_Box, 6).Value = j
               ElseIf i <= 52 Then
                    Worksheets("Data Entry").Cells(j + 2 + (i - 1) * Circum_Data_Points_Box, 5).Value = "A" & Chr(i + (64 - 26))
                    Worksheets("Data Entry").Cells(j + 2 + (i - 1) * Circum_Data_Points_Box, 6).Value = j 
    'This then goes on to if i<=78 etc. in a similar format before the loop ends

Current CountIf Function

CountNumbers = Application.WorksheetFunction.CountIf(Range("F:F"), 1)

Цикл, как указано выше, но в настоящее время не работает так, как мне нужно, как обсуждалось выше.

Любая помощь или указатели высоко ценится.Спасибо

Answer 1

Просто хотел показать вам упрощенную версию вашей ситуации:

Запуск этого кода:

Sub Test()

Dim X As Long
With ActiveWorkbook.Sheets("Sheet1")
    For X = 1 To 8 'Should be your Axial_Data_Points I assume
        .Range(.Cells(X, 8).Value & .Cells(X, 9).Value + 2).Offset(0, 2) = .Cells(X, 10).Value
    Next X
End With

End Sub

Послерабочий код:

Это тот цикл, который вы ищете?

Answer 2

Вместо цикла я бы использовал формулу (и впоследствии преобразовал ее в значения).Это должно быть быстрее, чем зацикливание всех ячеек.

Представьте следующее как рабочий лист My List

Так что введите следующеевведите в ячейку C3 (соответствующего листа A1 таблицы) и потяните ее вниз и вправо:

=IFNA(INDEX('My List'!$L:$L,MATCH(C$2&"-"&$B3,'My List'!$G:$G,0)),"-")

Чтобы получить следующий результат:

Или просто напишите формулу с помощью VBA в полную сетку всего одной строкой:

Range("C3:AP32").Formula = "=IFNA(INDEX('My List'!$L:$L,MATCH(C$2&""-""&$B3,'My List'!$G:$G,0)),""-"")"

Или, если вы не хотите, чтобы формулы заменили их значениями в обратном направлении:

Range("C3:AP32").Formula = "=IFNA(INDEX('My List'!$L:$L,MATCH(C$2&""-""&$B3,'My List'!$G:$G,0)),""-"")"
Range("C3:AP32").Value = Range("C3:AP32").Value