Ahoj.
Šlo by napsat makro které:
Vyhledá v listu "sestava" ve sloupci Q všechny buňky které mají hodnotu 1, ty nakopíruje, pak mi nabídne v PC vybrat soubor kde je již list "V seznamu ANO" a tam do slouce Q vloží data ? Ostatní buňky zůstanou beze změny.
VBA na přenos dat Vyřešeno
- elninoslov
- Level 2.5
- Příspěvky: 373
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: VBA na přenos dat
Aké dáta vloží na list "V seznamu ANO" do stĺpca Q ??? Veď žiadne nekopírujete. Na liste "sestava" sú predsa v Q, ako uvádzate, iba 1 a niečo iné. A kopírujete práve tie 1, ako tvrdíte. Tak načo ich kopírovať. Stačí iba zapísať na list "V seznamu ANO" do stĺpca Q zase iba 1. No ale ako vieme kam? Do ktorých riadkov. Dnes som tuším ešte na fórach zmysluplné zadanie nevidel
Upresnite to prosím, aj s prílohou.
Upresnite to prosím, aj s prílohou.
Re: VBA na přenos dat
Dobrá, asi jsem se dost nepřesně vyjádřil. No nevadí už jsem to nějak vyřešil. Ale mám ještě jinou věc.
Potřeboval bych však upravid kód (pokud je možno) takto:
Při inventuře načítám kódy zboží (čtečkou), kde se mi do tabulky k jedotlivým položkám vypisuje 1 jako nalezeno.
Vše v pořádku funguje pokud načídám všechny čárové kody s klasickým číslem 123500256 a podobně. Problém je v načtení kódů třeba
B 0025456, nebo D 00568025 nebo A 668545.. nebo jiné písmeno na začátku kódu. Vysvětlím. Jde mi o to, že tyto kódy jsou vyexportovány v sestavě k inventuře bez mezery jako B0025456, přitom v čárovém kódu je mezera. Ovšem ne vždy, někdy je čárový kód bez mezery a pak je vše v pořádku. Proto bych potřebovat zdaby šlo nějak ošetřit, aby v případě načtení těchto položek to nějak ignorovalo tu mezeru (aby to zkrátka našlo položku)
kod je :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Are As Range, Cas As Date, Vyplnuji(), CasZmeny(), Pocet As Long, i As Long
Set Zmena = Intersect(Columns("Q").Resize(Rows.Count - 1).Offset(1, 0), Target)
If Not Zmena Is Nothing Then
Cas = Now()
For Each Are In Zmena.Areas
Pocet = Are.Cells.Count
If Pocet = 1 Then
ReDim Vyplnuji(1 To 1, 1 To 1): Vyplnuji(1, 1) = Are.Value
ReDim CasZmeny(1 To 1, 1 To 1): CasZmeny(1, 1) = Are.Offset(0, 1).Value
Else
Vyplnuji = Are.Value
CasZmeny = Are.Offset(0, 1).Value
End If
For i = 1 To Pocet
CasZmeny(i, 1) = IIf(Vyplnuji(i, 1) = 1, Cas, Empty)
Next i
Application.EnableEvents = False
Are.Offset(0, 1).Value = CasZmeny
Application.EnableEvents = True
Next Are
End If
End Sub
Potřeboval bych však upravid kód (pokud je možno) takto:
Při inventuře načítám kódy zboží (čtečkou), kde se mi do tabulky k jedotlivým položkám vypisuje 1 jako nalezeno.
Vše v pořádku funguje pokud načídám všechny čárové kody s klasickým číslem 123500256 a podobně. Problém je v načtení kódů třeba
B 0025456, nebo D 00568025 nebo A 668545.. nebo jiné písmeno na začátku kódu. Vysvětlím. Jde mi o to, že tyto kódy jsou vyexportovány v sestavě k inventuře bez mezery jako B0025456, přitom v čárovém kódu je mezera. Ovšem ne vždy, někdy je čárový kód bez mezery a pak je vše v pořádku. Proto bych potřebovat zdaby šlo nějak ošetřit, aby v případě načtení těchto položek to nějak ignorovalo tu mezeru (aby to zkrátka našlo položku)
kod je :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Are As Range, Cas As Date, Vyplnuji(), CasZmeny(), Pocet As Long, i As Long
Set Zmena = Intersect(Columns("Q").Resize(Rows.Count - 1).Offset(1, 0), Target)
If Not Zmena Is Nothing Then
Cas = Now()
For Each Are In Zmena.Areas
Pocet = Are.Cells.Count
If Pocet = 1 Then
ReDim Vyplnuji(1 To 1, 1 To 1): Vyplnuji(1, 1) = Are.Value
ReDim CasZmeny(1 To 1, 1 To 1): CasZmeny(1, 1) = Are.Offset(0, 1).Value
Else
Vyplnuji = Are.Value
CasZmeny = Are.Offset(0, 1).Value
End If
For i = 1 To Pocet
CasZmeny(i, 1) = IIf(Vyplnuji(i, 1) = 1, Cas, Empty)
Next i
Application.EnableEvents = False
Are.Offset(0, 1).Value = CasZmeny
Application.EnableEvents = True
Next Are
End If
End Sub
- elninoslov
- Level 2.5
- Příspěvky: 373
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: VBA na přenos dat
Človeče nešťastný ... najskôr popis, ktorému sa nedá porozumieť, potom bez prílohy, veď my si máme predsa vždy vytvárať prostredie a dáta a usporiadanie pre otestovanie riešenia sami, a následne ako čerešničku uvediete kód z iného listu. Tento nič predsa nehľadá. Dal som si tú prácu, pozrel Vaše príspevky, našiel vlákno ktorého sa to týka, tam prílohu, a v nej TENTO VYHĽADÁVACÍ KÓD
Stačilo to
upraviť na
PS: Ak na fórum vkladáte nejaký kód, ktorý je formátovaný a usporiadaný tabulátormi a apostrofami, tak je tak urobený aby bol prehľadnejší, to sú základné vizuálne konvencie pri programovaní. A na to je vymyslená Tag značka "". Do nej máte ten kód umiestniť. Aby ostal prehľadný, keď si ten kód niekto skopíruje do Excelu a ide Vám ho upraviť a vyskúšať. Vy keď ho nedáte do značiek/Tag-ov, tak sa to vizuálne formátovanie tabulátormi stratí, kód sa zneprehľadní, a dotyčný si to potom musí znovu sprehľadňovať aby sa mu ľahšie Vám pomáhalo.
Je pravda, že niektoré fóra tabulátory v CODE neberú, ale tu áno, a treba to použiť.
Takže: Je toto, to, čo ste chcel?
Kód: Vybrat vše
Private Sub Worksheet_Change(ByVal Target As Range)
Dim BunkaKod As Range
Set BunkaKod = Intersect(Target, Range("J2"))
If Not BunkaKod Is Nothing Then
If Not IsEmpty(BunkaKod) Then
On Error Resume Next
With Worksheets("Sestava").Cells(WorksheetFunction.Match(Replace(BunkaKod, " ", ""), Worksheets("Sestava").Columns(IIf(Worksheets("Inventura").Range("F2").Value = 1, "F", "N")), 0), "Q")
If Err.Number = 0 Then
If .Value = 1 Then
MsgBox "Tento kód byl již v inventuře načten! Opakuj načtení"
Else
.Value = 1
End If
Application.EnableEvents = False
BunkaKod.ClearContents
Application.EnableEvents = True
Else
MsgBox "Neznámý kód! Produkt nenalezen. Opakuj načtení"
End If
End With 'Worksheets("Sestava").Cells(WorksheetFunction.Match(Replace(BunkaKod, " ", ""), Worksheets("Sestava").Columns(IIf(Worksheets("Inventura").Range("F2").Value = 1, "F", "N")), 0), "Q")
On Error GoTo 0
End If
End If
End Sub
Stačilo to
Kód: Vybrat vše
...Match(BunkaKod...
upraviť na
Kód: Vybrat vše
...Match(Replace(BunkaKod, " ", "")...
PS: Ak na fórum vkladáte nejaký kód, ktorý je formátovaný a usporiadaný tabulátormi a apostrofami, tak je tak urobený aby bol prehľadnejší, to sú základné vizuálne konvencie pri programovaní. A na to je vymyslená Tag značka "
Kód: Vybrat vše
[code]...[/code]
Je pravda, že niektoré fóra tabulátory v CODE neberú, ale tu áno, a treba to použiť.
Takže: Je toto, to, čo ste chcel?
Re: VBA na přenos dat Vyřešeno
NO super. Je to tak, když se dělá moc věcí najednou.
Děkuju. moc jste mi pomohl. Supr
Děkuju. moc jste mi pomohl. Supr
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 11
- 2139
-
od Grander
Zobrazit poslední příspěvek
30 črc 2023 15:20
-
- 8
- 1625
-
od sasshrek
Zobrazit poslední příspěvek
22 lis 2023 08:45
-
-
Nový tablet a přenos obrazu do televize
od Radekkk » 16 zář 2023 22:22 » v Mobily, tablety a jiná přenosná zařízení - 2
- 3624
-
od Radekkk
Zobrazit poslední příspěvek
18 zář 2023 09:08
-
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 31 hostů