Каков более короткий способ написания этого кода?

Question

Я сделал этот превосходный код VBA с помощью записи макросов и хотел бы знать более короткий способ его записи с помощью какого-то цикла ввода, может быть?

Лист имеет два ввода, которые меняются во времениони обнаружены в клетках (B5: Y5) и (B8: Y8).Код выбирает первый вход (B5) и вставляет его в соответствующую ячейку (J16).Затем он копирует другой вход (B8) и вставляет его в соответствующую ячейку (N12).Лист вычисляет два выхода, и код копирует их из ячеек (H41) и (K41) в таблицу «РЕЗУЛЬТАТЫ» внизу.

Это повторяется для следующего столбца ячеек в разделе «ВХОДЫ» и продолжается до конца входов.

Я понимаю, что это очень грубый способ сделать это и был бы очень признателен за любую помощь.

Имейте в виду, я полный нуб код:)

Sub CopyVariables()
'
' CopyVariables Macro
'

'
    Range("J16").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-11]C[-8]"
        Range("N12").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "=R[-4]C[-12]"
                Range("H41").Select
                Selection.Copy
                Range("E47").Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                    Range("K41").Select
                    Application.CutCopyMode = False
                    Selection.Copy
                    Range("E48").Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False


    Range("J16").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=R[-11]C[-7]"
        Range("N12").Select
        Application.CutCopyMode = False
        ActiveCell.FormulaR1C1 = "=R[-4]C[-11]"
            Range("H41").Select
            Selection.Copy
            Range("F47").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                    Range("K41").Select
                    Application.CutCopyMode = False
                    Selection.Copy
                    Range("F48").Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False

....

и продолжает повторять для каждой ячейки в отдельности.

Answer 1

Попробуйте приведенный ниже код (НЕ ПРОВЕРЕНО). дайте мне знать, если это работает

Option Explicit
Sub CreateTestResultTable()

    Application.ScreenUpdating = False 'makes your code go faster, can also disable events and calculation but dont know how it will affect you


    Dim ws As Worksheet

    Dim colInp As Integer, colOut As Integer
    Const t_air_in_Row = 5
    Const RH_in_Row = 8
    Const t_air_out_Row = 47
    Const RH_air_out_Row = 48
    Const TimeIn_Row = 3
    Const TimeOut_Row = 46

    'set starting column
    colInp = 2
    colOut = 5

    Set ws = ActiveSheet

    While ws.Cells(TimeIn_Row, colInp).Value <> "" 'check if time input is not blank - the loop will continue till there are no more values.

        'set values
        ws.Range("J16").Value = ws.Cells(t_air_in_Row, colInp).Value 't_air_in
        ws.Range("N12").Value = ws.Cells(RH_in_Row, colInp).Value 'RH_in

        'calculate the sheet
        ws.Calculate
        DoEvents

        'copy output values into report
        ws.Cells(TimeOut_Row, colOut).Value = ws.Cells(TimeIn_Row, colInp).Value 'time
        ws.Cells(t_air_out_Row, colOut).Value = ws.Range("H41").Value 't_air_out
        ws.Cells(RH_air_out_Row, colOut).Value = ws.Range("K41").Value 'RH_air_out

        'increment column count
        colInp = colInp + 1
        colOut = colOut + 1
    Wend

    Application.ScreenUpdating = True

End Sub

Answer 2

Попробуйте

Sub test()
    Dim vData, vResult()
    Dim c As Integer, i As Integer

    c = Range("b5").End(xlToRight).Column
    vData = Range("b5", Cells(8, c))
    c = UBound(vData, 2)
    ReDim vResult(1 To 2, 1 To c)
    For i = 1 To c
        Range("j16") = vData(1, i)
        Range("n12") = vData(4, i)
        vResult(1, i) = Range("h41")
        vResult(2, i) = Range("k41")
    Next i
    Range("e47").Resize(2, c) = vResult

End Sub