Prosím o upravu zápisu vyhledání
Napsal: 09 dub 2022 16:20
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
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