• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Marko, cyklus import dat z ARES

Zaslal/a Milan-Munzar 1.11.2017 9:59

Dobrý den,
prosím o pomoc s makrem. Potřebuji, aby prošel 1000 názvů spol. (A2:A1001) a vypsal IČ (sloupec B). Nevím jak správně napsat cyklus, aby vzal název A2 a vypsal IČ do B2, pokračoval na A3 -> B3, A4 atd. až X...

Dim oblast As Range, bunka As Range
Set oblast = Range("a1:a1001")
For Each bunka In oblast
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ares"
Sheets("ares").Activate

ActiveWorkbook.XmlImport Url:="http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_std.cgi?obchodni_firma=" & Sheets(1).Range(bunka).Value, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")

Sheets(1).Activate

Sheets(1).Range("B2") = Sheets("ares").Range("AK3")
Sheets("ares").Delete
Next bunka

Moc děkuji za jakoukoliv radu.
Milanmunzar@gmail.com
Milan

Zaslat odpověď >

---

misocko(2.11.2017 8:47)#038229

minuuly tyzden som takto riesil vyhladanie a prenos, avsak z dvoch excel. Neviem ako funguje ares, mozno ťa to aspon nakopne.
Sub prenos()

For r = 1 To 1001 'prejde bunky v cielovom liste
firma = Cells(r, 1).Value
Windows(pdp).Activate 'ja tu prechadzam na zdrojovy list, neviem ako sa ide na ares
Sheets("Plan").Select 'vyberiem pozadovany list s datami
For r_plan = 1 To 1001 'prejdem bunky v zdojovom liste , u teba ares
If firma = Cells(r_plan, 1).Value Then 'ked najde firmu podla nazvu
IC = Cells(r_plan, 2).Value 'ulozi hodnotu z toho idteho riadku, druheho stlpca do IC
Windows(hs).Activate 'prechod na cielovy subor
Cells(r, 2).Value = IC 'ic ulozi do riadku kde bol zdroj pre firmu
GoTo diel_preneseny
End If
Next r_pdp 'zabezpeci prechod vsetkych 1000 riadkov v zdoji (u teba ares, neviem teda ci to takto funguje)
Windows(hs).Activate 'ak taku firmu nenajde v zdroji tak prejde na cielovy subor , kde prejde na dalsiu firmu
diel_preneseny:
Next r 'prejde vsetkych 1000 riadkov v zdroji

End Subcitovat

Taky-Milan(2.11.2017 11:17)#038233

Funguje, ověřeno - jen to poměrně dlouho trvá (import něco zabere) a název musí být správně, překlik v názvu = neuspěch v importu toho řádku

Sub ares()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For i = 2 To 1001
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ares"
Sheets("ares").Activate

ActiveWorkbook.XmlImport Url:="http://wwwinfo.mfcr.cz/cgi-bin/ares/darv_std.cgi?obchodni_firma=" & Sheets(1).Cells(i, 1).Value, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A$1")

Sheets(1).Activate

Sheets(1).Cells(i, 2) = Sheets("ares").Range("AK3")

Sheets("ares").Delete 'smazání pomocného listu

Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = FaTruelse

End Subcitovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse