excel - 向宏添加循环

Question

下午好，

我有一个工作中的定价模型，我必须手动填写它才能确定我们的预测。我基本上将数据从一张纸复制/粘贴到下一张，让公式计算价格形状。我想在我的宏中添加一个循环以减少手动过程。

我想要表格“帐户列表”中的数据，当时是一个行范围，从 range 开始G2:R2，将转置（行到列，列到行）复制到表格“输入”中，从单元格开始C10。这将产生我的定价。然后我会转到工作表“输出”并复制选择F5:C28并将其转储到工作表“加载配置文件”中。我想循环它每次将数据添加到从单元格开始的工作表“加载配置文件”的底部，直到工作表“帐户列表A1”中没有更多数据，即到达列中的空白单元格。G

以下是我到目前为止的内容：

 Sub Button2_Click()

  Sheets("Account List").Select
  Range("G2:R2").Select
  Selection.Copy
  Sheets("Input").Select
  Range("C10").Select
  Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= False, _
      Transpose:=True
  Sheets("Output").Select
  Range("F5:AC28").Select
  Selection.Copy
  Sheets("Load Profiles").Select
  Range("A1").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, _
      Transpose:=False

End Sub

标签： excelvbaloops

Answer 1

美国在线

Option Explicit

Sub AIOL()

  Const cStrAL As String = "Account List"
  Const cStrIn As String = "Input"
  Const cStrOut As String = "Output"
  Const cStrLP As String = "Load Profiles"

  Const cStrRngAL As String = "G2:R2"
  Const cStrRngIn As String = "C10"
  Const cStrRngOut As String = "F5:AC28"
  Const cStrRngLP As String = "A1"

  Dim rngAL As Range
  Dim rngIn As Range
  Dim rngOut As Range
  Dim rngLP As Range

  Dim vnt1 As Variant    ' Array 1: Account List Array, Output Array
  Dim vnt2 As Variant    ' Array 2: Input Array

  Dim lngRow As Long     ' Account List Range Rows Counter
  Dim intCol As Integer  ' Array Columns/Rows Counter

  With ThisWorkbook
    Set rngAL = .Worksheets(cStrAL).Range(cStrRngAL)
    Set rngIn = .Worksheets(cStrIn).Range(cStrRngIn)
    Set rngOut = .Worksheets(cStrOut).Range(cStrRngOut)
    Set rngLP = .Worksheets(cStrLP).Range(cStrRngLP)
  End With

  ' ClearContents of 'Load Profiles'.
  rngLP.Resize(Rows.Count, rngOut.Columns.Count).ClearContents

  ' Assuming data in first column of rngAL is contiguous i.e. spans from the
  ' first row's cell to the cell before the first empty cell.
  For lngRow = rngAL.Row To rngAL.Cells(1, 1).End(xlDown).Row

    ' Paste 'Account List' into Array 1.
    vnt1 = rngAL.Offset(lngRow - rngAL.Row, 0)

      ' Resize Array 2.
      ReDim vnt2(1 To UBound(vnt1, 2), 1 To 1)
      ' Transpose Array 1 to Array 2 (rows to columns and columns to rows).
      For intCol = 1 To UBound(vnt1, 2)
        vnt2(intCol, 1) = vnt1(1, intCol)
      Next

    Erase vnt1

    ' Paste Array 2 into 'Input'.
    rngIn.Resize(UBound(vnt2), 1) = vnt2

    Erase vnt2

    ' Paste 'Output' into Array 1.
    vnt1 = rngOut

      ' Paste Array 1 into 'Load Profiles'.
      If lngRow > rngAL.Row Then
        rngLP.Parent.Cells(Rows.Count, rngLP.Column).End(xlUp).Offset(1, 0) _
            .Resize(UBound(vnt1), UBound(vnt1, 2)) = vnt1
       Else
        ' Only first run through.
        rngLP.Resize(UBound(vnt1), UBound(vnt1, 2)) = vnt1
      End If

    Erase vnt1

  Next

  ' Clean up.
  Set rngAL = Nothing
  Set rngIn = Nothing
  Set rngOut = Nothing
  Set rngLP = Nothing

End Sub