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

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

Он создает новый лист и ссылается на старый лист ... код копирует и вставляет строки ... Он просто не выполняет цикл do в нужное количество раз. Я пробовал разные операнды (> = 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
Ryland Moyar 26 Ноя 2018 в 22:01

1 ответ

Лучший ответ

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

  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
0
urdearboy 26 Ноя 2018 в 19:48