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: 386
- 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 38 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
-
-
Prosím o radu jak předělat PC
od ruzi.jiri » 22 srp 2024 07:54 » v Rady s výběrem hw a sestavením PC - 8
- 2520
-
od Zivan
Zobrazit poslední příspěvek
23 srp 2024 12:10
-
-
- 2
- 1268
-
od Alferi
Zobrazit poslední příspěvek
11 led 2025 17:38
-
- 6
- 8130
-
od Alferi
Zobrazit poslední příspěvek
10 bře 2025 18:05
-
- 5
- 2539
-
od michal84
Zobrazit poslední příspěvek
07 dub 2025 10:11
-
-
Herní PC prosím o názory/tipy/rady
od Samlitt » 05 dub 2025 07:43 » v Rady s výběrem hw a sestavením PC - 1
- 1429
-
od meda2016
Zobrazit poslední příspěvek
05 dub 2025 09:11
-
Kdo je online
Uživatelé prohlížející si toto fórum: Seznam[Bot] a 3 hosti