PC-HELP.CZ

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 ?

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

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 56 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.

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.

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 54 x

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

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

Nejaký ten príklad

PC-HELP.CZ

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

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

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

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

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

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

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