Stránka 1 z 1

Makro VBA kopírování z jiného sešitu

Napsal: 28 srp 2017 09:48
od Acce
Dobrý den ahoj,

mohli byste mi prosím poradit ohledně maker v Excelu?? Už si nevím rady. Nějakým způsobem s VBA zvládám začátky, případně si makro nahraju záznamem.Tak se pokusím nejpřesněji popsat co přesně potřebuji.
Po spuštění makra v sešitu 1 se podle hodnot ve sloupci K podívá do neaktivního sešitu2(v dokumentech) a vyhledá stejné hodnoty, které jsou (v sešitu2) ve sloupci L a v případě nalezení shody zkopíruje ze sešitu2 buňku ze sloupce A do sešitu1 do sloupce L.

Předem děkuji za jakékoliv pokusy o pomoc. :lookround:

Re: Makro VBA kopírování z jiného sešitu

Napsal: 29 srp 2017 10:15
od elninoslov
2 príklady. V oboch sú použité na dolovanie dát vzorce, ktoré sú vložené makrom. Prvý počíta s rovnakým názvom listu prehľadávaného súboru, druhý počíta s tým, že list na prehľadanie je vždy prvý v poradí.

Re: Makro VBA kopírování z jiného sešitu

Napsal: 29 srp 2017 11:32
od Acce
Vypadá, že nebude chybět moc a začne to fungovat, nicméně zatím tomu tak není....v prvním případě po výběru dokumentu se nestane vůbec nic, v případě druhém po nakliknutí souboru, v kterém by měl hledat, hodí chybu v řádku - With Workbooks.Open(Subor) ...Děkuji, vážím si toho :-)

Re: Makro VBA kopírování z jiného sešitu

Napsal: 29 srp 2017 15:16
od elninoslov
Zmente tie hodnoty A,c,d napr. na C,D,A, a stavím sa, že si všimnete rozdielne výsledky. Pozrite sa do Zošit2, či je usporiadaný ako ten Váš (ktorý nemáme). Dajte si BreakPoint (klik myši na tenký stĺpec vľavo od kódu) na riadok

Kód: Vybrat vše

Subor = VyberSubor

a makro si odkrokujte, sledujte výsledok.

Druhé makro - skúste si zmeniť ten "diskutabilný" riadok na

Kód: Vybrat vše

Workbooks.Open (Subor)
  With ActiveWorkbook

a rovnako si dajte BreakPoint na rovnaký riadok a makro si cez F8 po spustení odkrokujte.

U mňa fungujú obe. Tu bude záležať na informáciách, ktoré neposkytujete, verzia Office, skutočné rozmiestnenie dát, a pod.

Re: Makro VBA kopírování z jiného sešitu

Napsal: 29 srp 2017 15:34
od Acce
Pokusný dokumenty už se rozběhly, super...teď to úspěšně zavést do ostré verze....Díky moc, nečekal sem, že mi někdo až takto pomůže. Jen ještě jedna drobnost, jelikož dokument, ze kterého se berou data, je pořád na jednom místě jak by vypadal řádek s kodem bez ručního zadání dokumentu, cesta by byla přímo v makru.... Díky...posílám alespoň pomyslného panáka borovičky...už teď jste mi opravdu pomohl :clap: :thumbup:

Dodatečně přidáno po 2 minutách 5 vteřinách:
verze office je 2007 (12.0.4518.1014), rozmístění dat ve sloupcích je jak jsem psal...máte na mysli rozmístění souborů ??

Re: Makro VBA kopírování z jiného sešitu  Vyřešeno

Napsal: 29 srp 2017 17:22
od elninoslov

Kód: Vybrat vše

Sub Vyhladaj()  'Ak sa volá list na prehľadávanie vždy "Hárok1"
Dim Subor As String, R As Long
  Subor = "Z:\Vyhľadávanie v inom zošite\Zošit2.xlsx"
  If Len(Dir(Subor)) = 0 Then MsgBox ("Súbor neexistuje." & vbNewLine & Subor): Exit Sub
  Subor = "'" & WorksheetFunction.Replace(Subor, InStrRev(Subor, "\"), 1, "\[") & "]Hárok1'!"
 
  With ActiveSheet
    R = .Cells(Rows.Count, 11).End(xlUp).Row - 1
    If R > 0 Then
      With .Cells(2, 12).Resize(R)
        .Formula = "=IF(ISERROR(MATCH(K2," & Subor & "$L:$L,0)),"""",INDEX(" & Subor & "$A:$A,MATCH(K2," & Subor & "$L:$L,0)))"
        .Value2 = .Value2
      End With
    End If
  End With
End Sub


Kód: Vybrat vše

Sub Vyhladaj2() 'Ak je list na prehľadávanie vždy 1. v poradí (bez ohľadu na meno listu)
Dim Subor As String, R As Long, WSN As String
  Subor = "Z:\Vyhľadávanie v inom zošite\Zošit2.xlsx"
  If Len(Dir(Subor)) = 0 Then MsgBox ("Súbor neexistuje." & vbNewLine & Subor): Exit Sub
 
  Application.ScreenUpdating = False
  Workbooks.Open (Subor)
  With ActiveWorkbook
    WSN = .Worksheets(1).Name
    .Close False
  End With
  Application.ScreenUpdating = True
 
  Subor = "'" & WorksheetFunction.Replace(Subor, InStrRev(Subor, "\"), 1, "\[") & "]" & WSN & "'!"
  With ActiveSheet
    R = .Cells(Rows.Count, 11).End(xlUp).Row - 1
    If R > 0 Then
      With .Cells(2, 12).Resize(R)
        .Formula = "=IF(ISERROR(MATCH(K2," & Subor & "$L:$L,0)),"""",INDEX(" & Subor & "$A:$A,MATCH(K2," & Subor & "$L:$L,0)))"
        .Value2 = .Value2
      End With
    End If
  End With
End Sub

Re: Makro VBA kopírování z jiného sešitu

Napsal: 31 srp 2017 16:01
od Acce
Děkuji moc, včera jsem byl pracovně pryč, takže jsem na to koukl až dnes...ve vzorovém sešitu vše fungovalo, v reálnym dokumentu ne, nakonec byl nejspíš problém ve formátu sešitu, celý sem zkopíroval a vytvořil nový soubor, po nepatrných úpravách vše funguje, jak jsem si představoval...Díky moc, opravdu si toho vážím...zastávám heslo: ''Když můžu tak pomůžu''..a jsem rád, že nejsem sám. Ještě jednou díky elninoslov