Mám kód kdy mi vyhledá zboží (dle kódu) v sestavě (to je list1 pojmenovaný jako "Sestava"), zapíše do řádku 17 (1) jedničku
Pokud nenajde vyskočí MsgBox s hlášením..
Potřeboval bych kod upravit:
Aby při opakovaném (duplicitním) načtení stejného již načteného kódu vyskočil také MsgBox s hlášením (Kód byl již v inventuře načten)
To zmamená, pokud je již v příslušném řádku ve sloupci 17 zapsaná 1 (jenička) vyskočí upozornění
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$I$2" Then
If Not IsEmpty(Target) Then
On Error Resume Next
With Sheets("Sestava").Cells(Application.WorksheetFunction.Match(Target.Value, Sheets("Sestava").Columns(14), 0), 17)
If Err.Number = 0 Then
.Value = 1
Target.ClearContents
Else
MsgBox "Neznámý kód! Produkt nenalezen. Opakuj načtení"
End If
End With 'Sheets("Sestava").Cells(Application.WorksheetFunction.Match(Target.Value, Sheets("Sestava").Columns(14), 0), 17)
On Error GoTo 0
End If
End If
End Sub
Prosím o upravu zápisu vyhledání
- elninoslov
- Level 2.5
- Příspěvky: 373
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Prosím o upravu zápisu vyhledání
Príklad:
Kód: Vybrat vše
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Kod As String
If Not Intersect(Range("$I$2"), Target) Is Nothing Then
Kod = Range("$I$2").Value2
If Len(Kod) > 0 Then
On Error Resume Next
With Sheets("Sestava").Cells(WorksheetFunction.Match(Kod, Sheets("Sestava").Columns(14), 0), 17)
If Err.Number = 0 Then
If .Value <> "" Then MsgBox "Kód byl již v inventuře načten", vbExclamation, "Upozornění" Else .Value = 1
Range("$I$2").ClearContents
Else
MsgBox "Neznámý kód! Produkt nenalezen. Opakuj načtení", vbCritical, "Chyba"
End If
End With 'Sheets("Sestava").Cells(WorksheetFunction.Match(Kod, Sheets("Sestava").Columns(14), 0), 17)
On Error GoTo 0
End If
End If
End Sub
- Přílohy
-
- Inventura - ověření kódu.xlsm
- (18.59 KiB) Staženo 26 x
Re: Prosím o upravu zápisu vyhledání
Díky, už se mi podařilo vyřešit. Ale je to přesně ono. Děkuju
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
-
Sestava cca 50 000,- prosím o názor, či úpravu
od Hejhul » 18 dub 2024 11:47 » v Rady s výběrem hw a sestavením PC - 2
- 2133
-
od Alferi
Zobrazit poslední příspěvek
18 dub 2024 12:58
-
-
- 3
- 2018
-
od Lukk_as93
Zobrazit poslední příspěvek
24 dub 2024 15:37
-
- 2
- 3554
-
od bereline
Zobrazit poslední příspěvek
19 črc 2023 11:10
-
- 6
- 2554
-
od vaclavka83
Zobrazit poslední příspěvek
01 kvě 2024 01:59
-
-
Nové herní PC do 45k, prosím o kontrolu
od JohnyyGO » 15 úno 2024 20:42 » v Rady s výběrem hw a sestavením PC - 13
- 1968
-
od JohnyyGO
Zobrazit poslední příspěvek
16 úno 2024 16:00
-
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 19 hostů