Zaslal/a
24.10.2018 14:28Zdravím. Potřeboval bych poradit. Mám dva soubory - jeden s daty a druhý do kterého se ta data zapisují. Již jsem se pokusil makro napsat, ale nechce fungovat (jsem začátečník), viz. níže. Můžete mi poradit, v čem dělám chybu?
Makro má ze souboru DATA do souboru KLIENTI nahrávat částky podle čísel klientů a podle čísla měsíců.
V souboru KLIENTI obsahuje první řádek názvy sloupců: A1 (Klienti), B1 až M1 (Čísla měsíců). Ve sloupci Klienti jsou zapsaná čísla klientů 1000 až 1005.
V souboru DATA obsahuje první řádek názvy sloupců:
A1 (Klienti), B1 (Číslo měsíce) a C1 (Částka, která se má nahrát).
Omlouvám se, že sem nedám žádnou přílohu, ale nějak nevím jak ji sem přidat.
Děkuji mockrát. :)
Sub Klient_ID()
Dim wsData, wsOutput As Worksheet 'Odkaz na list Data a list Klienti
Dim wbData, wbOutput As Workbook 'Odkaz na sešit Data, odkaz na sešit Klienti
Dim SKlient As Integer 'Číslo sloupce obsahující číslo klienta
Dim SMesic As Integer 'Číslo sloupce obsahující číslo měsíce
Dim SCastka As Integer 'Číslo sloupce obsahující částku
Dim Mesic As Integer 'Číslo měsíce z Dat
Dim Cestka As Integer 'Částka z Dat
Dim PocetRadkuD, PocetRadkuK As Integer 'Počet řádku v sešitu Data a Klienti
Dim RadekOut, SloupecOut As Integer 'Řádek a sloupec pro zápis dat do buňky
Dim CisloSesitu As Integer 'Číslo sešitu obsahující název Klienta
'-------------------------------------------------------------------------------
Application.ScreenUpdating = False
'Zapamatuj si aktivní sešit a list s Daty
Set wbData = ActiveWorkbook
Set wsData = ActiveSheet
'Předdefinovaná čísla klíčových sloupců v sešitu Data
SKlient = 1 'Sloupce A obsahuje číslo klienta
SMesic = 2 'Sloupec B obsahuje číslo měsíce
SCastka = 3 'Sloupec C obsahuje částku
'Počet řádků souboru Data
PocetRadkuD = Cells(Rows.Count, SKlient).End(xlUp).Row
'Zjištění identifikace souboru s výstupní tabulkou (název začíná KLIENTI)
CisloSesitu = 0
For i% = 1 To Workbooks.Count
If Left(Workbooks(i%).Name, 7) = "KLIENTI" Then CisloSesitu = i%
Next i%
If CisloSesitu = 0 Then
MsgBox "Není otevřen sešit KLIENTI* se vzorem výstupní tabulky", vbCritical, "KLIENTI_ERROR"
GoTo Konec
End If
Workbooks(CisloSesitu).Activate
Set wbOutput = ActiveWorkbook
Set wsOutput = ActiveSheet
wsOutput.Activate
PocetRadkuK = Cells(Rows.Count, 1).End(xlUp).Row
'----------------------------------------------------------------------------------
' Hlavní cyklus na procházení souboru Data
'----------------------------------------------------------------------------------
For i% = 2 To PocetRadkuD
'Načtení zdrojového záznamu
Mesic = wsData.Cells(i%, SMesic).Value
Castka = wsData.Cells(i%, SCastka).Value
Klient = wsData.Cells(i%, SKlient).Value
wsOutput.Activate
'Nalezení polička v Klienti
RadekOut = 0
SloupecOut = Mesic + 1
For j% = 2 To PocetRadkuK
j% = PocetRadkuK
Next j%
If RadekOut = 0 Then GoTo Dalsi
wsOutput.Cells(RadekOut, SloupecOut) = wsOutpu.Cells(RadekOut, SloupecOut).Value + Castka
Dalsi:
Next i%
Konec:
End Sub
elninoslov napsal/a:
Tak len príklad...
Ten Váš kód fungovať nemôže z niekoľkých dôvodov. Premenná RadekOut nikdy nenadobudne inú hodnotu ako 0. Následný cyklus For j% by mal hľadať klienta, no nerobí vôbec nič :) Ďalej o pár riadkov nižšie wsOutput nieje to isté ako wsOutpu.
Uvádzam 2 rozličné prípady. Jeden pridáva neexistujúceho klienta, druhý ho ignoruje.
Je to len ukážka. Záležať bude na tom, koľko dát spracovávate, lebo potom by sa vynechal zápis celého poľa dát, a prepisovali by sa napr. iba zmenené riadky (pozor zápis všetkých napr. 1000 riadkov po 13 stĺpcov nemusí byť pomalší ako zápis 20 riadkov po jednom), alebo by sa mohla použiť kolekcia a pod.
Ale na to slúži poriadne popísaná príloha s príkladom.Příloha: 41741_data-klientu.zip (27kB, staženo 2x)
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.