Příspěvky uživatele
< návrat zpět
Funguje perfektně, děkuji za pomoc.
-- Mé makro
Sub test()
Dim wsData As Worksheet
Dim wsForm As Worksheet
Dim sFirstFound As String, rList As Range, rLookFor As Range
Dim result As Range, LR As Long
' DEFINOVANI LISTU
Set wsData = ThisWorkbook.Worksheets("data")
Set wsForm = ThisWorkbook.Worksheets("form")
' DEFINOVANI DB JMEN
Set rList = wsData.Range("A1:A" & wsData.Cells(Rows.Count, 1).End(xlUp).Row)
' DEFINOVANI OBLASTI CO HLEDAT
Set rLookFor = wsForm.Range("H2:H150")
' ZJISTENI POSLEDNI POUZITE RADKY VE SLOUPCI "A" V LISTE FORM
LR = wsForm.Range("A" & Rows.Count).End(xlUp).Row
' KDYZ BUDE VETSI NEZ 3, JE TREBA OBLAST VYMAZAT
If LR > 3 Then
wsForm.Range("A4:D" & LR).ClearContents
End If
' VYHLEDANI JMENA V DB JMEN
Set result = rList.Find(rLookFor.Value)
If Not result Is Nothing Then
' POKUD JE JMENO NALEZENO ULOZ POZICI DO RETEZCE
sFirstFound = result.Address
Do
' DEFINOVANI PRVNI VOLNE RADKY V LISTU FORM
LR = wsForm.Range("A" & Rows.Count).End(xlUp).Row + 1
' PRENESENI VYHLEDANYCH DAT NAT POZADOVANOU RADKU
wsForm.Range("A" & LR).Resize(1, 4) = result.Resize(1, 4).Value
' POKRACOVANI HLEDANI DALSIHO VYSKYTU OD POZICE POSLEDNIHO VYSKYTU
Set result = rList.FindNext(result)
' OPAKUJ CYKLUS "DO" DOKUD JE VYRAZ VYHLEDAN A JEHO POZICE JE JINA NEZ PRVNI ULOZENA
Loop While Not result Is Nothing And result.Address <> sFirstFound
End If
End Sub
Zdravím,
Potřeboval bych pomoci s makrem.
Upravil jsem makro které hledá hodnoty podle definovaného identifikátoru (najdi hodnotu X a dotáhni k ní hodnotu Y z druhé tabulky)
Toto funguje, nyní bych makro potřeboval rozšířit tak abych mohl zadat těch hodnot X několik desítek, a on je postupně prošel a ke všem vypsal hodnoty Y.
V příloze zasílám makro které toto provede s jednou proměnou. Pokoušel jsem se to vymyslet i pro více X, ale makro zpracuje první hodnotu X, vypíše hodnoty Y a poté skončí a další hodnoty nehledá a nevím jak dál.
Děkuji za pomoc
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články