What's a shorter way of writing this code?

Обновить

April 2019

Просмотры

91 раз

1

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

Лист имеет два входа, которые изменяются в зависимости от времени, они находятся в клетках (B5: Y5) и (B8: Y8). Код поднимает первый вход (B5), и вставляет его в свою соответствующую ячейку (J16). Затем она копирует другой вход (В8) и вставляет его в свою соответствующую ячейку (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

....

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

Sid

2 ответы

2

Try the below code (NOT TESTED). let me know if this works

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
2

Try

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