Question

我已经通过宏录制制作了这个excel 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

编写此代码的较短方法是什么？

2 个答案: