VBA na přenos dat Vyřešeno

[junis]

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.

[Reklama]

[elninoslov]

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.

[junis]

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

[elninoslov]

Č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

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]

". 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?

[junis]

NO super. Je to tak, když se dělá moc věcí najednou.
Děkuju. moc jste mi pomohl. Supr