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

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Acce
nováček
Příspěvky: 4
Registrován: srpen 17
Pohlaví: Muž
Stav:
Offline

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

Příspěvekod Acce » 28 srp 2017 09:48

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:

Reklama
Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

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

Příspěvekod elninoslov » 29 srp 2017 10:15

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í.
Přílohy
Zošit1.xlsm
(20.1 KiB) Staženo 103 x

Acce
nováček
Příspěvky: 4
Registrován: srpen 17
Pohlaví: Muž
Stav:
Offline

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

Příspěvekod Acce » 29 srp 2017 11:32

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 :-)

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

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

Příspěvekod elninoslov » 29 srp 2017 15:16

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.
Přílohy
Zošit2.xlsx
(8.04 KiB) Staženo 82 x

Acce
nováček
Příspěvky: 4
Registrován: srpen 17
Pohlaví: Muž
Stav:
Offline

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

Příspěvekod Acce » 29 srp 2017 15:34

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ů ??

Uživatelský avatar
elninoslov
Level 2.5
Level 2.5
Příspěvky: 366
Registrován: červen 13
Pohlaví: Muž
Stav:
Offline

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

Příspěvekod elninoslov » 29 srp 2017 17:22

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

Acce
nováček
Příspěvky: 4
Registrován: srpen 17
Pohlaví: Muž
Stav:
Offline

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

Příspěvekod Acce » 31 srp 2017 16:01

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


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • com.android.documentsui - jak přenést z jiného zařízení
    od MK_Vs » 06 pro 2023 11:49 » v Mobily, tablety a jiná přenosná zařízení
    0
    1641
    od MK_Vs Zobrazit poslední příspěvek
    06 pro 2023 11:49
  • Kopírování řádků s funkcí když Příloha(y)
    od Martyn20 » 20 črc 2023 16:50 » v Kancelářské balíky
    3
    1786
    od Melvidor Zobrazit poslední příspěvek
    21 črc 2023 08:41
  • Obnoveni ztracenych fotek z telefonu pri kopirovani do pc
    od Dizzy66 » 21 led 2024 17:08 » v Vše ostatní (sw)
    2
    1018
    od šulda Zobrazit poslední příspěvek
    23 úno 2024 07:12
  • Makro pro myš Rapture Python
    od mmmartin » 27 srp 2023 15:18 » v Problémy s hardwarem
    9
    1111
    od mmmartin Zobrazit poslední příspěvek
    29 srp 2023 16:47

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 5 hostů