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ž

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
Level 2
Příspěvky: 247
Registrován: červen 13
Pohlaví: Muž

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
Nemáte oprávnění prohlížet přiložené soubory.

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

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

Příspěvekod deuzsen » včera, 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

Sešit1.xlsm


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.
Nemáte oprávnění prohlížet přiložené soubory.

Uživatelský avatar
elninoslov
Level 2
Level 2
Příspěvky: 247
Registrován: červen 13
Pohlaví: Muž

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

Příspěvekod elninoslov » včera, 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ž

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

Příspěvekod deuzsen » včera, 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

Sešit2.xlsx


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


TestPlan.xlsm


Jen zda by to šlo vyřešit elegantněji?
Nemáte oprávnění prohlížet přiložené soubory.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Vyhledání v tabulce dvě pravidla
    od luko02420 » 05 dub 2020 20:48 » v Kancelářské balíky
    4
    300
    od luko02420
    06 dub 2020 07:38
  • Vyhledání nejvyšší hodnoty na základě podmínek
    od Joselinne » 21 lis 2019 10:13 » v Kancelářské balíky
    1
    665
    od elninoslov
    21 lis 2019 16:12
  • Excel-vyhledání fotbalových výsledků vzorec
    od darkwall » 06 čer 2019 13:23 » v Kancelářské balíky
    5
    917
    od karlos64
    07 čer 2019 20:53
  • excel sčítání hodnot jiného počtu
    od berate » 14 lis 2019 15:08 » v Kancelářské balíky
    4
    654
    od atari
    15 lis 2019 09:13
  • Win 10 přesun souborů HDD
    od Sedli02 » 03 led 2020 20:17 » v Problémy s hardwarem
    4
    322
    od Sedli02
    03 led 2020 21:08

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

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 0 hostů