VBA Как создать цикл проверки данных с одним значением копирования / вставки и смещения - PullRequest
0 голосов
/ 04 октября 2018

Я хочу создать макрос, который перебирает список проверки данных, который я поместил в ячейку C8 на листе с именем Gym Weekly Template.Для каждого значения в списке проверки данных (список состоит из данных из диапазона A6: A45 из листа «Данные тестирования»), у меня есть значение vlookup, которое генерируется в ячейке W73 того же листа.

Я хочу вставить каждое значение из ячейки W73 в новую рабочую таблицу с именем Gym Load Monitoring, начиная с ячейки B2 и вниз по столбцу B завершение макроса после прохождения списка проверки данных.Если возможно, если бы мне нужно было запустить макрос еще раз, я бы хотел, чтобы он распознал, что в столбце B на рабочем листе Gym Load Monitoring и вставил значения в следующий пустой столбец, и так далее для каждого раза,макрос запускаетсяЯ написал текущий код, но у меня такое ощущение, что я совершенно не в курсе:

Sub PasteLoads()
Dim dvCell As Range
Dim inputRange As Range
Dim c As Range
Dim i As Long


'Which cell has data validation
Set dvCell = Worksheets("Gym Weekly Template").Range("C8")

'Determine where validation comes from
Set inputRange = Evaluate(dvCell.Validation.Formula1)

i = 1
Application.ScreenUpdating = False
For Each c In inputRange
    dvCell = c.Value

    With Worksheets("Gym Load Monitoring")
        ThisWorkbook.Sheets("Gym Weekly Template").Range("W73").Copy.Range("B" & .Rows.Count).End (xlUp)

Next c
Application.ScreenUpdating = True


End Sub

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

1 Ответ

0 голосов
/ 04 октября 2018

Добавлено несколько дополнительных переменных, чтобы уменьшить количество повторений, и проверка, чтобы убедиться, что вы пишете в пустой столбец каждый раз, когда запускаете Sub.

Не проверено:

Sub PasteLoads()
    Dim shtGWT As Worksheet, shtGLM As Worksheet
    Dim dvCell As Range
    Dim inputRange As Range, resultRange As Range
    Dim c As Range
    Dim i As Long, nextCol As Long


    Set shtGWT = Worksheets("Gym Weekly Template")
    Set shtGLM = Worksheets("Gym Load Monitoring")

    'Which cell has data validation
    Set dvCell = shtGWT.Range("C8")
    Set resultRange = shtGWT.Range("W73")

    'Determine where validation comes from
    Set inputRange = Evaluate(dvCell.Validation.Formula1)

    nextCol = 2
    'find an empty column
    Do While Application.CountA(shtGLM.Cells(2,nextCol).Resize(500, 1)) > 0
        nextCol = nextCol + 1
    Loop

    i = 2
    Application.ScreenUpdating = False
    For Each c In inputRange.Cells
        dvCell.Value = c.Value
        shtGLM.Cells(i, nextCol).Value = resultRange.Value
        i = i + 1
    Next c
    Application.ScreenUpdating = True


End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...