Как вставить данные в столбцы и строки таким образом

Question

У меня есть некоторые данные этикетки для печати в формате столбцов и строк на основе заданного пользователем значения ввода. Это 3 основных условия на основе входных данных:

1) Нет стартовой метки для пропуска 2) Нет метки на строку 3) Нет строк на страницу

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

Лист данных

Печать листа

Мои коды ограничены 3 столбцами с неограниченным количеством строк и без пропуска

Здесь Можете ли вы настроить эти коды для пользовательской формы: Сделайте его небольшим и эффективным - это коды для динамического создания пользовательского текстового поля c, предоставленные @Brian M Stafford, но не знаете, как реализовать для этой цели

Public Sub GenerateLabels()
Dim CopyRowValue As String
Dim SecondDataCol, ThirdDataCol, FirstDataCol As Long
Dim SecondDataRow, ThirdDataRow, FirstDataRow As Long

Set shdata = ThisWorkbook.Sheets("Database")
Set shgenerate = ThisWorkbook.Sheets("LabelGenerate")
Set shDesignFormat = ThisWorkbook.Sheets("LabelDesignFormatBeforePrint")

FirstDataCol = shgenerate.Cells(1, shgenerate.Columns.Count).End(xlToLeft).Column
SecondDataCol = shgenerate.Cells(1, shgenerate.Columns.Count).End(xlToLeft).Column
ThirdDataCol = shgenerate.Cells(1, shgenerate.Columns.Count).End(xlToLeft).Column

FirstDataRow = shgenerate.Cells(shgenerate.Rows.Count, "A").End(xlUp).Row
SecondDataRow = shgenerate.Cells(shgenerate.Rows.Count, "C").End(xlUp).Row
ThirdDataRow = shgenerate.Cells(shgenerate.Rows.Count, "E").End(xlUp).Row

'======== Copy From Data Sheet============

Last_Row = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row

For r = 2 To Last_Row  

shdata.Cells(x, "A").Copy
shDesignFormat.Range("B3").Paste 'pasting data to design sheet before print (to format data)

CopyRowValue = Worksheets("Database").Cells(r, "B").value 

For r2 = 1 To CopyRowValue 

'=====Paste to Generate Sheet ====

'Cells(FirstDataRow + 1, FirstDataCol + 1).Offset(0, 0).Select
If IsEmpty(shgenerate.Cells(FirstDataRow + 0, FirstDataCol + 0).Offset(0, 0).value) = True Then

shDesignFormat.Range("B3").Copy _
Destination:=shgenerate.Cells(FirstDataRow + 0, FirstDataCol + 0).Offset(0, 0)

ElseIf IsEmpty(shgenerate.Cells(SecondDataRow + 0, SecondDataCol + 2).Offset(0, 0).value) = True Then 'offset used to find empty cell if design layout changed
shDesignFormat.Range("B3").Copy _
Destination:=shgenerate.Cells(SecondDataRow + 0, SecondDataCol + 2).Offset(0, 0)

ElseIf IsEmpty(shgenerate.Cells(ThirdDataRow + 0, ThirdDataCol + 4).Offset(0, 0).value) = True Then
shDesignFormat.Range("B3").Copy _
Destination:=shgenerate.Cells(ThirdDataRow + 0, ThirdDataCol + 4).Offset(0, 0)


SecondDataRow = SecondDataRow + 2
ThirdDataRow = ThirdDataRow + 2
FirstDataRow = FirstDataRow + 2

End If

Next r2

Next r

Application.CutCopyMode = False

End Sub

Answer 1

Глядя на ваш код, я подумал, что его можно упростить. Как только я это сделал, я начал вносить изменения, чтобы добавить необходимые требования. Основной задачей было отслеживание текущего местоположения. Код закончился так:

Option Explicit

Public Sub GenerateLabels(ByVal LabelsToSkip As Integer, ByVal LabelsPerRow As Integer, ByVal RowsPerPage As Integer)
   Dim shdata As Worksheet
   Dim shgenerate As Worksheet
   Dim shDesignFormat As Worksheet
   Dim curRow As Long
   Dim curCol As Long
   Dim RowsPerPageCount As Long
   Dim r As Long
   Dim r2 As Long

   Set shdata = ThisWorkbook.Sheets("Database")
   Set shgenerate = ThisWorkbook.Sheets("LabelGenerate")
   Set shDesignFormat = ThisWorkbook.Sheets("LabelDesignFormatBeforePrint")

   shgenerate.UsedRange.ClearContents

   curRow = 1
   curCol = 1
   RowsPerPageCount = 1

   For r = 2 To shdata.Range("A" & Rows.Count).End(xlUp).Row
      '======== Copy From Data Sheet============
      shdata.Cells(r, "A").Copy
      shDesignFormat.Range("B3").PasteSpecial  'pasting data to design sheet before print (to format data)

      For r2 = 1 To shdata.Cells(r, "B").Value + LabelsToSkip
         '=====Paste to Generate Sheet ====
         If curCol > LabelsPerRow * 2 Then  '* 2 for double spacing
            curCol = 1

            If RowsPerPage > 0 And (RowsPerPageCount + 1) Mod (RowsPerPage + 1) = 0 Then
               curRow = curRow + 10  'new page
               RowsPerPageCount = 1
            Else
               curRow = curRow + 2
               RowsPerPageCount = RowsPerPageCount + 1
            End If
         End If

         If r2 > LabelsToSkip Then
            LabelsToSkip = 0
            shDesignFormat.Range("B3").Copy Destination:=shgenerate.Cells(curRow, curCol)
         End If

         curCol = curCol + 2
      Next r2
   Next r

   Application.CutCopyMode = False
End Sub

Я рекомендую использовать Option Explicit и объявить все необходимые переменные.