VBA - vyhledání a přepis do jiného souboru

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

Moderátor: Mods_senior

deuzsen
nováček
Příspěvky: 6
Registrován: duben 20
Pohlaví: Muž
Stav:
Offline

VBA - vyhledání a přepis do jiného souboru

Příspěvekod deuzsen » 21 kvě 2020 12:58

Zdravím,

Moc prosím o pomoc s VBA. Co potřebuji aby makro umělo? V sešitu 1, list 1, zapíšu hodnotu. A v sešitě 2 v listu 1, prohledat celý sloupec A. Jakmile se najde shoda, tak se mi celý řádek načte do sešitu 2, do listu 2. Vše aby fungovalo na tlačítko.
Do teď jsem používal funkci Svyhledat, ale potřebuji předělat do trochu složitější formy a ohledně VBA jsem začátečník.

Moc děkuji za pomoc

Dodatečně přidáno po 20 minutách 33 vteřinách:
Doplním, kam jsem se já sám dostal:

Workbooks.Open ("cesta k souboru sešit 1")
promena = ActiveWorkbook.Worksheets("list1").Range("C4")
ThisWorkbook.Activate
Worksheets("List5").Range("A1") = promena

Taky bych potřeboval nahradit "Workbooks.Open", protože ten soubor mám neustále otevřený a pracuji s ním.

Ale to se mi přepíše jen jedna buňka. Potřebuji jednoduše vypsat celý řádek, protože v sešitu 1 hledám název výrobku a zpět potřebuji vypsat další parametry. Jde to udělat přes SVyhledat, ale to je mraky vzorců, ještě když musím používat IFERROR pro více listů.

Moc děkuji

Dodatečně přidáno po 55 minutách 9 vteřinách:
Zkouším nyní takto:

Sub otevri()

Dim dohledat As String

Z = Worksheets("List5").Range("A1")

Workbooks.Open ("cesta k souboru")
dohledat = WorksheetFunction.VLookup(Z, Worksheets("04 Duben").Range("C4:F500"), 4, False)
ThisWorkbook.Activate
Worksheets("List5").Range("B1") = dohledat


End Sub

teď bych přidal několik proměných, které chci dohledat a vrátit zpět, ale není elegantnější řešení? Plus jak se zbavit toho Workrbook.Open ?

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

Re: VBA - vyhledání a přepis do jiného souboru

Příspěvekod elninoslov » 21 kvě 2020 14:37

Nástrel. Kým som to naťukal, zmenil ste kód, tým pádom popis problému. Skúste či Vás to inšpiruje. Ak nie, pridajte reálne súbory (bez citlivých dát, nie prázdne) a lepší popis.

Kód: Vybrat vše

Sub Zapis()
Dim R As Long, Vyrobek, WBC As Workbook
Const CestaC = "D:\Sešit2.xlsx"

    On Error Resume Next
    Set WBC = Workbooks(CestaC)
    If WBC Is Nothing Then
        Application.ScreenUpdating = False
        Set WBC = Workbooks.Open(CestaC)
        ThisWorkbook.Activate
        Application.ScreenUpdating = True
        If WBC Is Nothing Then MsgBox "Soubor nelze otevřít." & vbNewLine & CestaC, vbCritical: Exit Sub
    Else
        If WBC.FullName <> CestaC Then MsgBox "Je otevřen soubor z nesprávného adresáře." & WBC.FullName & vbNewLine & "Správná cesta :" & vbNewLine & CestaC, vbCritical: Exit Sub
    End If
    On Error GoTo 0
   
    Vyrobek = ThisWorkbook.Worksheets("list1").Cells(2, 1).Value
    If IsEmpty(Vyrobek) Then Exit Sub
   
    With WBC.Worksheets("list1")
        On Error Resume Next
        R = WorksheetFunction.Match(Vyrobek, .Cells(1, 1).Resize(.Cells(Rows.Count, 1).End(xlUp).Row), 0)
        If Err.Number <> 0 Then MsgBox "Nenalezeno.", vbCritical: Exit Sub
        On Error GoTo 0
        WBC.Worksheets("list2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 5).Value = .Cells(R, 1).Resize(1, 5).Value
    End With
End Sub
Přílohy
vba.zip
(25.02 KiB) Staženo 52 x

deuzsen
nováček
Příspěvky: 6
Registrován: duben 20
Pohlaví: Muž
Stav:
Offline

Re: VBA - vyhledání a přepis do jiného souboru

Příspěvekod deuzsen » 25 kvě 2020 09:38

Dobrý den,

Děkuji, podívám se na to, ale chvilku mu to zabere to přelouskat.

Dodatečně přidáno po 37 minutách 38 vteřinách:
Jestli jsem to pochopil dobře, tak v sešitu 1 zapíšu název výrobku a otevře se mi sešit 2 a vyhledá list, kde je tento výrobek zapsán?
Pokud použiji vaše soubory a přepíšu názvy výrobku, tak že se neshodují, tak potřebuji při otevřených obou souborech toto:
V sešitu 1 napíšu název výrobku A1 a dolů do pole výsledek se mi vypíše tento výrobek(název, parametry a další) právě ze sešitu 2. Potřebuji vlastně určitou hodnotu najít a společně s dalšími údaji ji vrátit zpět do sešitu 1.

Sešit2.xlsx
(10.71 KiB) Staženo 55 x

Sešit1.xlsm
(19.18 KiB) Staženo 50 x


Dodatečně přidáno po 42 minutách 31 vteřinách:
ještě vysvětlím proč to potřebuji. Když píši objednávku na nákup výrobku, tak musím složitě z jednoho souboru vypisovat všechny údaje o výrobku. Jde to jednodušeji udělat přes funkci Svyhledat, ale pokud máte potom x listu, tak to je hrůza vypisovat. Proto hledám takovéto řešení, ale VBA moc neovládám.

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

Re: VBA - vyhledání a přepis do jiného souboru

Příspěvekod elninoslov » 25 kvě 2020 10:46

Ani nesťahujem prílohy. V 1. príspevku píšete
V sešitu 1, list 1, zapíšu hodnotu. A v sešitě 2 v listu 1, prohledat celý sloupec A. Jakmile se najde shoda, tak se mi celý řádek načte do sešitu 2, do listu 2.

a teraz píšete
potřebuji při otevřených obou souborech toto:
V sešitu 1 napíšu název výrobku A1 a dolů do pole výsledek se mi vypíše tento výrobek(název, parametry a další) právě ze sešitu 2.

To je presný opak.
Takýto popis vzniká tým, že nepomenúvate veci tak ako sa volajú, ale namiesto toho sešit1, sešit2, list1 sešitu2, list2 sešitu1, list2 sešitu2 a list1 sešitu1. Ľahko sa popletiete. A potom si ešte ľudia zamieňajú slovo zošit s list. To ale nieje Váš prípad.
Prosím priložte normálne pomenované súbory a listy, a popis napíšte podľa nich. Nevidím dôvod, prečo by nemal byť Váš problém vyriešiteľný. Ale premýšľať ako to myslíte a hľadať logiku sa mi nechce.
Peace.

deuzsen
nováček
Příspěvky: 6
Registrován: duben 20
Pohlaví: Muž
Stav:
Offline

Re: VBA - vyhledání a přepis do jiného souboru

Příspěvekod deuzsen » 25 kvě 2020 11:19

Omlouvám se za špatný popis, ono je celkem jedno kam se to vypíše, podstatné pro mě je, aby se mi hodnoty někam vypsaly. Zkusím to popsat lépe.
Znám název výrobku "A1" a ten zadám v Sešitu 1 do buňky A2.
Makro mi potom prohledá Sešit2, všechny listy a najde shodu s názvem výrobku "A1".
Následně do Sešitu1 kamkoliv vrátí hodnoty ze sešitu 2, které našel, včetně všech hodnot v daném řádku.

Sešit1.xlsm
(19.18 KiB) Staženo 56 x

Sešit2.xlsx
(10.88 KiB) Staženo 54 x


Z přiložených souborů to snad bude již dobře srozumitelné.
Zkouším to přes funkci SVyhledat, ale nevím jak ve VBA zadat, aby funkce prohledala všechny listy a ne jen jeden konkrétní.

WorksheetFunction.VLookup(vyrobek, Worksheets("List1").Range("A1:C50"), 2, False)

Dodatečně přidáno po 1 hodině 31 minutách 19 vteřinách:
Prozatím jsem vyřešil takto:

Sub nactidata()
Dim HPO As String
Dim PLN As Workbook
Const Cesta = "...TestPlan.xlsm"

Dim DN As String
Dim DV As String

HPO = Worksheets("Data").Range("B1")
Workbooks.Open (Cesta)
On Error Resume Next
DN = WorksheetFunction.VLookup(HPO, Worksheets("List1").Range("A1:C50"), 2, False)
DN = WorksheetFunction.VLookup(HPO, Worksheets("List2").Range("A1:C50"), 2, False)
DV = WorksheetFunction.VLookup(HPO, Worksheets("List1").Range("A1:C50"), 3, False)
DV = WorksheetFunction.VLookup(HPO, Worksheets("List2").Range("A1:C50"), 3, False)

ThisWorkbook.Activate
Worksheets("Data").Range("B2") = DN
Worksheets("Data").Range("B3") = DV

End Sub

Objednávka_test_2.1..xlsm
(18.88 KiB) Staženo 53 x


TestPlan.xlsm
(9.48 KiB) Staženo 55 x


Jen zda by to šlo vyřešit elegantněji?

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

Re: VBA - vyhledání a přepis do jiného souboru

Příspěvekod elninoslov » 26 kvě 2020 21:18

Nejaký ten príklad
Přílohy
Objednávka_test_2.1..xlsm
(40.92 KiB) Staženo 73 x


  • 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
    1648
    od MK_Vs Zobrazit poslední příspěvek
    06 pro 2023 11:49
  • Tisk ELD souboru
    od Jandak » 30 dub 2023 09:53 » v Problémy s hardwarem
    4
    1103
    od Grander Zobrazit poslední příspěvek
    09 čer 2023 21:31
  • Přenos souborů SD - USB flash bez PC
    od Asanoth » 29 črc 2023 17:35 » v Sítě - hardware
    11
    2032
    od Grander Zobrazit poslední příspěvek
    30 črc 2023 15:20
  • Jak hromadně změnit datum a čas souborů?
    od atari » 11 črc 2023 14:41 » v Programování a tvorba webu
    2
    2334
    od atari Zobrazit poslední příspěvek
    13 črc 2023 10:52
  • Volné řazení souborů ve složce
    od FIDLIK » 04 dub 2023 20:47 » v Windows 11, 10, 8...
    1
    1369
    od Karrex Zobrazit poslední příspěvek
    27 dub 2023 09:46

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ů