Re: Jak ve VBA zapomenout hodnotu proměnné?
Napsal: 11 čer 2020 13:05
Áaaaá, ale už viac fakt nestíham ..
Kód: Vybrat vše
Sub kopiruj()
Dim aHledat(), aPosun(), Data(), i As Integer, Radek_c As Long, Radku As Long
Const SLOUPCU = 5 'Počet kopírovaných sloupců dat
Const PRVNI_RS = 3 'První řádek dat v sestavě
Const PRVNI_SS = 3 'První sloupec dat v sestavě
aHledat = Array("Hangers", "Cartridges") 'Pole hledaných slov
aPosun = Array(6, 15) 'Pole posunů
Radek_c = 3 'První řádek pro zápis v Cíl
With wsSestava
Radku = .Cells(Rows.Count, PRVNI_SS).End(xlUp).Row - 2 'Počet řádků zdrojových dat v sestavě
If Radku = 0 Then MsgBox "Sestava bez dat.", vbExclamation: Exit Sub
Data = .Cells(PRVNI_RS, PRVNI_SS).Resize(Radku, SLOUPCU).Value
End With
Application.ScreenUpdating = False
For i = 0 To UBound(aHledat) 'Postupné spracování všech hledaných slov
Zpracuj Data, Radek_c, SLOUPCU, CStr(aHledat(i))
Radek_c = Radek_c + aPosun(i)
Next i
Application.ScreenUpdating = True
End Sub
Sub Zpracuj(ByRef Data, Radek As Long, SLOUPCU As Integer, Hledat As String)
Dim i As Long, y As Integer, Pole()
Const PRVNI_SC = 1 'První sloupec dat v Cíl
For i = 1 To UBound(Data, 1) 'Projít pole zdrojových dat (pole Data je odevzdané odkazem)
If Data(i, 2) = Hledat Then
ReDim Pole(1 To 1, 1 To SLOUPCU) 'Příprava pole kopírovaných dat
For y = 1 To SLOUPCU 'Vyplnění pole kopírovaných dat
Pole(1, y) = Data(i, y)
Next y
wsCil.Cells(Radek + Data(i, 3) - 1, PRVNI_SC).Resize(, SLOUPCU).Value = Pole 'Zápis pole kopírovaných dat na správnou pozici
End If
Next i
End Sub