AIOL

Question

下午好，

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

我想从工作表“ 帐户列表”中获取数据，一次从范围 G2:R2 开始行行范围，复制转置（行到列，列到行），从单元格 C10 开始进入“ 输入”工作表。这将产生我的价格。然后，我将转到工作表“ 输出”，然后复制选择 F5:C28 ，并将其转储到工作表“ Load Profile ”中。我想循环循环，每次将数据添加到表格“ Load Profile ”的底部，从单元格 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

Answer 1

那应该让您入门。您可以根据自己的需要对代码进行调整。

Sub Button2_Click()

    Dim cll As Range
    Dim lng As Long

    ' Assuming the numbers for pricing are in cells G2:R2 in the Account List sheet
    For Each cll In Sheets("Account List").Range("G2:R2")

        ' Loop thru every number and populate cells C10 on the Input sheet
        Sheets("Input").Range("C10").Value = cll.Value

        ' Find the last row on be Load Profile sheet
        With Sheets("Load Profile")
            lng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Row

        ' Copy data from the Output sheet to the first available row on the Load Profile sheet
            .Range("A" & lng).Value = Sheets("Output").Range("F5:C28").Value

        End With

    Next

End Sub

Answer 2

AIOL

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

向宏添加循环

2 个答案:

AIOL