MS Excel: Využití Makra - propojení dvou souborů Vyřešeno

[Lueticky_kretek]

Hezký den přeji.

Dostal jsem v práci pro mne dost neřešitelný problém. Za jakkoukoliv pomoc předem děkuji.
Budu se to snažit popsat co nejpřesněji.

Při vytištění faktury za různé služby se vytvoří soubor F_číslofaktury.xls ( F_28480.xls)
Za každou fakturu nový soubor resp. F_číslofaktury+1.xls (F_28481.xls,atd.)

Potřebuji z této faktury přvzít určité údaje, zvýrazněné žlutě v přiloženém souboru F_28480.xls a převést do konkrétních buněk v souboru vzor.xls, který též přikládám.

Problém I.

Požadované údaje jsou uložené jako TXT a ne do jednotlivých buněk (údaje Základ DPH,DPH,Cena Celkem).
Zde by asi šlo použít DATA/Text do sloupců. Nevím,ale jak to přenést poté automaticky do výsledného souboru (vzor.xls),jelikož řádek na kterém budou důležité hodnoty se můžou měnit ( jednou základ DPH na řádku 29, podruhé na 30,atd),ale vždy bude částka uvedena ve stejném řádku jako Cena celkem .

Problém II.

Nevím, jak v Makru nastavit,aby prošel např. všechny soubory v daném adresáři,kde budou uvedeny všechny F_číslofaktury.xls a z nich nakopírovat příslušné položky.

Opravdu budu vděčný za jakkoukoliv pomoc s tímto problémem.

[Reklama]

[navstevnik]

Jakmile si najdu trochu casu, navrhnu reseni.
V souboru F_28480.xls je i cislo faktury, je zapotrebi je prenest do souboru vzor.xls a pripadne kam vlozit?

[Lueticky_kretek]

Díky moc.
Ano, v souboru F_28480.xls je i číslo faktury (Sloučené buňky I,J 3,4,5,6 číslo dokladu), které bych potřeboval přenést do vzor.xls sloupec B s tím,že by se před to přidalo písmeno f.

Kdyby to šlo,tak použít makro v souboru vzor.xls, který by doplňoval řádky z adresáře XX,kde by byly vždy uloženy příslušné soubory s fakturama.

Opravdu budu rád za jakkokoliv pomoc.

[jardal]

Tak jsem zkusil z faktury dostat "Základ DPH". Asi by to uměl někdo líp, ale u mě je to funkční. Podobně jde udělat zbytek...
Třeba to pomůže.

Kód: Vybrat vše

Sub Makro1()
hledame = "Základ DPH (pro sazbu" 'co hledame
  Set hled_ = Cells.Find(hledame, LookIn:=xlValues) 'vyhledávání
    If hled_ Is Nothing Then
        MsgBox "Nemohu nalézt Základ DPH" 'nenalezeno
       
        Else
 
        zaklad_dph = Cells(hled_.Row, hled_.Column).Text 'nalezen celý text
        zacatek = InStr(1, zaklad_dph, ")") 'Najdeme pozici )
        konec = InStr(1, zaklad_dph, "Kč")  'Najdeme pozici Kč
        zaklad_dph = Trim(Mid(zaklad_dph, zacatek + 1, konec - zacatek - 1)) 'vystřihneme mezi dvěma pozicema co potřebujeme a vymažem přebývající mezery,
        MsgBox zaklad_dph 'zobrazíme výsledek
    End If

   
End Sub

[Lueticky_kretek]

Ahoj, díky.
Děkuji,toto vypadá,že vezme údaj za Základ DPH,ale musím nějak pořešit jak ho dostat do vzor.xls.

Potřebuji hodnotu/částku za údajem Základ DPH,kterou musím přesunout do druhého vzor.xls.

Bohužel částka není uvedena v konkrétní buňce (textový charakter) a pozice/číslo řádku se může měnit, tak potřebuji nějak nastavit automaticky,aby najdeš-li na řádku slovo základ DPH, přesun částku za ním do vzor.xls do sloupce I3 pro první fakturu, I4 pro druhou atd.

[navstevnik]

V priloze je soubor Transfer.xls, ktery prenese data ze souboru faktura.xls v prislusnem katalogu (predpoklad je, ze obsahuje pouze soubory faktura) do souboru vzor.xls. Je to pracovni verze, podle potreby bude upravena.
Vloz na list Start prislusne cesty a nazvy, spustit tlacitkem.
PS.:pokud bude opakovane pouzivano, bude potreba zabranit duplicitnimu nacteni souboru faktura. Jak resit?

[Lueticky_kretek]

Díky,chlape.

Menší problém:-)

Pokud odmažu v souboru vzor.xls řádky 3,4,5 tzn. zůstanou řádky 1.a 2., aby prostě byl soubor prázdný pouze s popisem sloupců, vyskočí mi chyba Run-time error 1004.

Při debug Set TCll = .Range("e" & LstR + 2)

Větší test s více soubory, odzkouším až v práci.

Duplicitu bych neřešil, prostě to bude chyba obsluhy.
Soubory s fakturou nebudou již možné jakkoliv opravovat, tudíž provedou jednou ( nastavene-li chyba, odmaže si soubor vzor.xls, jako já a udělají to znova).

Ale i tak opravdu moc díky!

[navstevnik]

V priloze je upravena verze.
Polozka Jmeno Prijmeni je rozdelena na dve casti podle prvni mezery zleva.

[Lueticky_kretek]

Vypadá ,že to všechno funguje jak má.
Jediná drobnost, nejde nastavit řádkování do vzor.xls do sloupce A. 1.,2.,3. atd?

Pak už jen blbost, v souboru vzor.xls je sloupec V (jméno/firma) přiděleno vždy jméno, nelze nastavit, pokud ve F_28480.xls nalezne s.r.o., a.s. či spol. s r.o.,aby to nerozděloval jako jméno a příjmení a rovnou to hodil do sloupce V?
Tedka to je tak,že Firma je Firma, Příjmení s.r.o.?

A snad poslední dotaz, budu-li si chtít udělat změnu, že budu chtít např. přidat další údaj, myslíš,že bys mi naznačil co bych měl pro to udělat?!

Díky moc

[navstevnik]

K pripominkam:
"nejde nastavit řádkování do vzor.xls do sloupce A. 1.,2.,3. atd" - co je mineno radkovanim?
"jméno/firma" - jak identifikovat co je firma? to musis stanovit ty, bude to vzdy jen "s.r.o.", "a.s." či "spol. s r.o." a v teto podobe?
"přidat další údaj" - pro vlozeni do ciloveho listu je nutno stanovit ofset vuci sloupci E:E, dalsi odvisi od umisteni v souboru faktura.
Pokud to je pojmenovana oblast, pak takto (priklad - cilovy sloupec ma ofset 1 a je hodnota je nacitana z pojm. oblasti "splatnost" - jinak je nutno zadat adresu zdrojove bunky, neni nutna uprava, napr. rozdeleni, ...):

Kód: Vybrat vše

' presun dat, pojmenovane oblasti
    With SWsht
.....
TCll.Offset(0, 1).Value = .Range("splatnost").Value
....
    End With

Jine upravy je nutno udelat podle konretniho stavu, napr. zde dohledani a uprava polozek DPH, Celkem cena, Zaklad dane:

Kód: Vybrat vše

...
 ' prohledat blok ve sloupci C:C
      Set SBlok = .Range("c15", [c1000].End(xlUp))
      For Each SCll In SBlok.Cells
        If InStr(SCll.Value, "Cena celkem") > 0 Then
          TmpStr = Replace(SCll.Value, " Kè ", "")
          i = InStrRev(TmpStr, " ")
          TCll.Offset(0, 3).NumberFormat = "#0.00"
          TCll.Offset(0, 3).Value = CSng(Right(TmpStr, Len(TmpStr) - i))
        End If
        If InStr(SCll.Value, "Základ DPH") > 0 Then
          TmpStr = Replace(SCll.Value, " Kè ", "")
          i = InStrRev(TmpStr, " ")
          TCll.Offset(0, 4).NumberFormat = "#0.00"
          TCll.Offset(0, 4).Value = CSng(Right(TmpStr, Len(TmpStr) - i))
        End If
        If InStr(SCll.Value, "       DPH") > 0 Then
          TmpStr = Replace(SCll.Value, " Kè ", "")
          i = InStrRev(TmpStr, " ")
          TCll.Offset(0, 5).NumberFormat = "#0.00"
          TCll.Offset(0, 5).Value = CSng(Right(TmpStr, Len(TmpStr) - i))
        End If
      Next SCll
...

no a porozumet kodu, k dispozici je nekolik orientacnich poznamek v procedure VBA.

[Lueticky_kretek]

Díky.

I. řádkováním jsem myslel,že mi ke každému novému řádku přibude do sloupce A číslice 1.
Na druhý řádek, do sloupce A 2.
Na třetí řádek do sloupce A 3. , ...

II. Firmu bych právě detekoval podle přesných znaků tj. v řádku 10 bude-li uvedeno s.r.o, a.s., spol. s r.o. (mnou definovatelné údaje), tak to nerozděluj na jméno a příjmení,ale pouze do dej do sloupce V.
Nebude-li tam toto uvedeno, rozděl to do sloupců V a W, jako doposud.

Stejně obdivuji,že mi pomáháš:-)

[navstevnik]

V priloze je upraveny soubor.
S temi zkratkami firem asi budou potize, jednou uvadis "s.r.o." a v odpovedi k pripominkam uvadis "s.r.o"
Otestuj na vetsim souboru se vsemi variantami jmen a nazvu firem i variantami hodnot ostatnich polozek.