Excel-postupné ukládání Vyřešeno

[esi32]

Dobrý den,Mam sešit se šesti listy.1listKlient,2listDopis,3.listRámcová smlouva,4listFaktura,5listArchiv.O co mi jde.
Do listů zadávám pomocí formulářů.Postup je tento.Kontaktuje mě klient,zadám ho do listu Klient.V tomto listu klient čeká na prověření i několik dní a klientů zamozřejmě může být i víc a všichni čekají.pokud je klient v listu Klient,je automaticky i v listu Archiv.Z listu Klient do listu Archiv si makro hledá první prázdný řádek.To je v pořádku.Ale ted potřebuji aby když je klient prověřen,tak na listě Dopis doplním ke klientovi další údaje a tyto údaje potřebuji také vložit do listu Archiv.Tam už samozřejmě nemohu použít hledání prvního volného řádku.Tam potřebuji,aby se data přidala ke konkrétnímu klientovi.Uff...fuška to vysvětlit.Najde se někdo,kdo by to zvládl?Děkuji za případnou pomoc,v případě potřeby sešit přiložím.
Děkuji.

[Reklama]

[d1amond]

Vítej na PC-HELP

Nemělo by to být až tak těžké, ale chtělo by to dodat nějaká demo data. Skutečně se to těžko představuje a zatím jsem tu nepotkal tak dobrého analytika (ačkoliv ano, ale již dlouho tu nebyl)

[esi32]

Ahoj a dík za odezvu.Zasílám sešit s formuláři,mělo by to být patrné.Spouští se to z listu List1

[d1amond]

Řešil bych to funkcí, která vrátí číslo řádku klienta na listu Archiv

Kód: Vybrat vše


Function RadekKlienta(UIN As Variant) As Integer

Dim bunka As Range
Dim radek As Integer

On Error Resume Next

Set bunka = ThisWorkbook.Worksheets("Archiv").Columns(1).Find(What:=UIN, _
                            SearchOrder:=xlByRows, _
                            LookAt:=xlWhole, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
                           
'z nalezene bunky vezme radek
RadekKlienta = bunka.Row

End Function


Číslo řádku je hodně univerzální a dá se s ním dobře pracovat, funkci můžeš volat odkukoliv a kdykoliv. Příklad pro kopii hodnota1 (výše půjčky)

Kód: Vybrat vše

Sub Aktualizuj()
Dim hodnota1 As Variant
Dim UIN As Variant
Dim radek As Integer
Dim wsh1 As Worksheet
Dim wsh2 As Worksheet

Set wsh1 = ThisWorkbook.Worksheets("Dopis1")
Set wsh2 = ThisWorkbook.Worksheets("Archiv")

UIN = wsh1.Cells(16, 6).Value 'klient
hodnota1 = wsh1.Cells(23, 4).Value 'vyse pujcky

'vola se funkce RadekKlienta, jako parametr je uvedeno číslo klienta UIN
radek = RadekKlienta(UIN)

'co delat, kdyz neexistuje klient
If radek = 0 Then
    MsgBox "Nenalezen klient " & UIN, vbCritical
    Exit Sub
End If

'prenese hodnota1 do listu Archiv
wsh2.Cells(radek, 17).Value = hodnota1

End Sub


[esi32]

Děkuji za řešení,fungují obě.Čistá práce a nezbývá než smeknout klobouk před tvými znalostmi.Ještě jednou dík.

[d1amond]

Není zač. Pokud to bude vyhovovat a je to vše, označ za vyřešeno