VB-скопировать и вставить вложенный цикл в Excel - PullRequest
0 голосов
/ 26 ноября 2018

Итак, у меня проблема в том, что это приводит к случайным результатам с Qty.

Я пытаюсь сделать каждый кол-во (в их кол-во) новой строкой в ​​новой электронной таблице.

Он создает новый лист и ссылается на старый лист ... код копирует и вставляет строки ... Он просто не зацикливает работу в правильное количество раз.Я пробовал разные операнды (> = 0) и изменение значений переменных, чтобы сделать эту работу.

Кажется, что не существует паттерна того, почему это происходит.Иногда это происходит в правильном количестве циклов цикла, в других - нет.Это происходит на нескольких значениях.Любая помощь приветствуется.

Sub copyPasta()
'
' copyPasta Macro
' This will take the qty, if greater than one  in Column C and copy the row 
'to a new sheet the amount of time the qty.
'
'
'Set Variable Types
Dim lineItemQty As Integer
Dim newLineItemQty As Integer
Dim LastRow As Integer
Dim strSheetName As String
Dim newSheetName As String
Dim i As Integer

Application.DisplayAlerts = False

'name a variable after the existing active sheet
strSheetName = ActiveSheet.Name
'add a sheet in addition to the current
Sheets.Add After:=ActiveSheet
'set a variable used in loops to the sheet being copied to
newSheetName = ActiveSheet.Name
'Return to first sheet
Sheets(strSheetName).Activate
' Set For Loop to max row
LastRow = Sheets(strSheetName).Range("C:C").Find("*", searchdirection:=xlPrevious).Row

'for loop to run through all rows
For i = 3 To LastRow Step 1

    'initializing variable to Qty value in table
    lineItemQty = Range("C" & i).Value

    'initializing variable within in line of for looping
    newLineItemQty = lineItemQty

    'do while loop to keep copying/pasting while there are still qty's
        Do While newLineItemQty > 0

        'do while looped copy and paste
            'copy the active row
                Sheets(strSheetName).Activate
                Rows(i).Select
                Selection.Copy
            'paste active row into new sheet
                Sheets(newSheetName).Select
                Rows("3:3").Select
                Selection.Insert Shift:=xlDown


            newLineItemQty = newLineItemQty - 1

        Loop
Next i

Application.DisplayAlerts = True

End Sub

1 Ответ

0 голосов
/ 26 ноября 2018

Вы можете использовать ( или брать детали из ) нижеприведенную альтернативу.Пара примечаний, достойных примечания:

  1. Вам следует избегать использования .Select и .Activate.Подробнее см. здесь
  2. Жизнь проще, когда вы объявляете короткие переменные.Здесь у нас просто есть ws для worksheet и ns для newsheet.Затем вам нужно активно указать, на какой лист вы ссылаетесь в своем коде (вместо использования .Select или .Activate, чтобы сделать это путем добавления префикса ко всем объектам с соответствующей переменной рабочего листа)
  3. Вам не нужнодобавьте Step 1 в свой цикл.Это значение по умолчанию - его нужно добавлять только тогда, когда вы отклоняетесь от значения по умолчанию!
  4. Существует несколько способов добавления листов.Ничего плохого в том, как вы это сделали, - вот только альтернатива (урок обучения), которая оказывается моим предпочтительным методом.
  5. Чтобы скопировать n много раз, просто создайте вложенный цикл и для 1 to n.Обратите внимание, что мы никогда не используем переменную n внутри цикла, что означает, что точно такая же операция будет выполняться, мы просто хотим, чтобы она выполнялась n раз.

Sub OliveGarden()

Dim ws As Worksheet: Set ws = ThisWorkbook.ActiveSheet
Dim ns As Worksheet: Set ns = ThisWorkbook.Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count))
    ns.Name = ws.Name & " New"

Dim i As Long, c As Long

'Application.ScreenUpdating = False
For i = 3 To ws.Range("C" & ws.Rows.Count).End(xlUp).Row
    If ws.Range("C" & i) > 0 Then
        For c = 1 To ws.Range("C" & i)
            LRow = ns.Range("A" & ns.Rows.Count).End(xlUp).Offset(1).Row
            ws.Range("C" & i).EntireRow.Copy
            ns.Range("A" & LRow).PasteSpecial xlPasteValues
        Next c
    End If
Next i
'Application.ScreenUpdating = True

End Sub
...