Добавление цикла в макрос

Question

Добрый день,

У меня есть модель ценообразования на работе, которую я должен заполнить вручную, чтобы определить наш прогноз.По сути, я копирую / вставляю данные с одного листа на другой, позволяя формулам вычислять форму цены.Я хотел бы добавить цикл в мой макрос, чтобы сократить ручной процесс.

Я хотел бы получить данные из листа " Список счетов ", один диапазон строк за раз, начинаяс диапазоном G2:R2, скопировал транспонирование (строки в столбцы, столбцы в строки) в лист " Input ", начиная с ячейки 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

Answer 1

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

Answer 2

Это должно помочь вам начать.Вы можете внести свои коррективы в код в соответствии с вашими потребностями.

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