Как скопировать необязательно непрерывную часть строки на другой лист, если значение из данного столбца больше 0?

Question

Я много борюсь с VBA, так как я очень новичок в этом деле ...

Я должен преобразовать запас продуктов в другой формат, где есть несколько пар размера и количества, которыенужно конвертировать в уникальную пару размеров и количества для каждого размера продукта, если запас больше 0. Но я не могу понять, как это сделать в VBA.

Лучшее, что я мог сделатьчто-то в этом роде, скопируйте строку, если значение> 0:

Public Sub Copytest()
Dim rng As Range
Dim cell As Range
Dim lr As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws1.Range("C2:C" & lr)

For Each cell In rng
    If cell.Value > 0 Then
        cell.EntireRow.Copy
        If ws2.Range("A1").Value = "" Then
            ws2.Range("A2").PasteSpecial xlPasteValues
        Else
            ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        End If
    End If
Next cell

Application.CutCopyMode = False
Range("A1").Select
End Sub

Вот скриншот исходного и целевого листов:

Answer 1

Вам нужна базовая книга по программированию.Вы должны запрограммировать подробные шаги, которые вы будете делать вручную.Вот, ИМХО, хорошее начало с хорошими практиками: значимые имена, отступы, комментарии:

Public Sub Copytest()
  Dim irow1&, icol1&, irow2&, lastrow&
  Dim ws1 As Worksheet, ws2 As Worksheet
  Dim prodid, otherattr, size, quan ' cell values
  Set ws1 = Sheets("Sheet1")
  Set ws2 = Sheets("Sheet2")
  lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
  irow2 = 1 ' the output row
  For irow1 = 2 To lastrow ' the input row
    prodid = ws1.Cells(irow1, 1) ' productid
    otherattr = ws1.Cells(irow1, 8) ' other attrib
    For icol1 = 2 To 6 Step 2 ' the input column
      size = ws1.Cells(irow1, icol1)
      quan = ws1.Cells(irow1, icol1 + 1)
      If quan > 0 Then
        ws2.Cells(irow2, 1) = prodid
        ws2.Cells(irow2, 2) = size
        ws2.Cells(irow2, 3) = quan
        ws2.Cells(irow2, 4) = otherattr
        irow2 = irow2 + 1
      End If
    Next icol1
  Next irow1
  Range("A1").Select
End Sub