Sub invent()
Dim otv As String, poz As Range
Dim x, y(), c(), p(), a(), i As Long, j As Byte, k As Long
Application.ScreenUpdating = False
x = Range("B2:v" & Cells(Rows.Count, 2).End(xlUp).Row).Value
otv = Application.InputBox("Введите город", "111", "Россия")
ReDim y(1 To UBound(x) * 2, 1 To 6)
ReDim с(1 To UBound(x) * 2, 1 To 6)
ReDim p(1 To UBound(x) * 2, 1 To 6)
ReDim a(1 To UBound(x) * 2, 1 To 6)
For i = 1 To UBound(x)
j = j + 1: If j = 6 Then j = 1: k = k + 1
y(1 + 6 * k, j) = "Наименование:"
y(2 + 6 * k, j) = "номер:"
y(3 + 6 * k, j) = "ко-во:"
y(4 + 6 * k, j) = "тип:"
y(5 + 6 * k, j) = "цена1:"
y(6 + 6 * k, j) = "цена2:"
с(1 + 6 * k, j) = x(i, 4)
с(2 + 6 * k, j) = x(i, 7)
с(3 + 6 * k, j) = x(i, 10)
с(4 + 6 * k, j) = x(i, 16)
с(5 + 6 * k, j) = x(i, 20)
с(6 + 6 * k, j) = x(i, 21)
p(1 + 6 * k, j) = x(i, 2)
a(1 + 6 * k, j) = x(i, 5)
Next i
With Sheets("Бирки")
.Cells.EntireRow.Hidden = False: .Cells.ClearContents
.Cells(1, 1).Resize(6 * (k + 1), 1).Value = y
.Cells(1, 2).Resize(6 * (k + 1), 1).Value = с
.Cells(1, 3).Resize(6 * (k + 1), 1).Value = p
.Cells(1, 4).Resize(6 * (k + 1), 1).Value = a
For Each poz In .Cells(1, 1).Resize(6 * (k + 1))
If Len(poz) = 0 Then
Range(poz, poz.Offset(-1)).EntireRow.Hidden = True
End If
Next poz
End With
Application.ScreenUpdating = True
End Sub
|
