Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Excel do WZ

Odynnn · Świeżak Wersja: Win Office 2007 Posty: 2

Chcialbym stworzyc sobie w excelu cos na wzor wydawania WZ z magazynu. Tylko pierwszy moj problem jest taki ze chcialbym kazdy towar wpisywac za pomoca 3 cyfrowych kodow, gdyz tak jest poprostu szybciej. Np wpisuje 105 i klikam enter i zamiast cyfry pojawia sie pelna nazwa produktu. Jest cos takiego wogole mozliwe?

umiejead · Wysłany: 23-02-2021, 16:01

Witamy na Forum.

Jest. Załącz plik.
.

Odynnn · Świeżak Wersja: Win Office 2007 Posty: 2

Mniej wiecej tak to widze, fajnie jakby jeszcze po wpisaniu kodu cena sama wskakiwała, ale zeby ja mozna z panelu formularza odrazu edytowac. W arkuszu produkty wpisalem przykladowe dane i kody do nich.

WZ.xlsx

Pobierz Plik ściągnięto 9 raz(y) 8.4 KB

umiejead · Wysłany: 23-02-2021, 16:53

VBA/formuły -zał. - draft (przymiarka).
.

WZ (Odzyskany).xlsm

Pobierz Plik ściągnięto 5 raz(y) 17.22 KB

umiejead · Wysłany: 23-02-2021, 18:46

v.1.1.1:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws1 As Worksheet, ws2 As Worksheet, i&

Set ws1 = Sheets("Arkusz1")
Set ws2 = Sheets("Produkty")

On Error GoTo laEnd

Application.EnableEvents = False

If Not Intersect(Target, ws1.Range("A2:A12")) Is Nothing Then
i = Target.Row
If Not IsError(Application.VLookup(Target.Value, ws2.Range("A:C"), 2, 0)) Then
ws1.Cells(i, 2).Value = Application.VLookup(Target.Value, ws2.Range("A:C"), 3, 0)
ws1.Cells(i, 1).Value = Application.VLookup(Target.Value, ws2.Range("A:C"), 2, 0)
ws1.Cells(i, 3).Interior.Color = vbRed
ws1.Cells(i, 3).Select
Else
If Cells(i, 1).Value = "" Then
MsgBox "Na tym etapie usunięcie pozycji spowoduje tylko 'dziurę'.", vbExclamation, "Info"
ws1.Range(Cells(i, 1), Cells(i, 3)).ClearContents
Else
MsgBox "Nie ma takiego kodu: " & Target.Value & vbCrLf & _
vbCrLf & "Kod błędu: " & Err.Number, vbCritical, "Uwaga!"
ws1.Range(Cells(i, 1), Cells(i, 3)).ClearContents
ws1.Cells(i, 1).Select
End If
End If
End If

Application.EnableEvents = True

If Not Intersect(Target, ws1.Range("C2:C12")) Is Nothing Then
If IsNumeric(ws1.Cells(Target.Row, 3).Value) Then
Cells(Target.Row, 3).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Cells(Target.Row, 5).Value = ""
Cells(Target.Row + 1, 1).Select
Else
ws1.Cells(Target.Row, 5).Value = "Błąd!"
Exit Sub
End If
End If

Application.EnableEvents = True

Exit Sub

laEnd:
MsgBox "Błąd! " & vbCrLf & vbCrLf & Err.Number, vbCritical, "Uwaga!"
ws1.Range(Cells(i, 1), Cells(i, 3)).ClearContents
Application.EnableEvents = True

End Sub

Kopia WZ (Odzyskany).xlsm

Pobierz Plik ściągnięto 6 raz(y) 21.3 KB

sp3wbe · Starszy Forumowicz Wersja: Win Office 2016 Posty: 29

Z VBA można robić naprawdę zabawne rzeczy. Umiejead jest expertem, ja natomiast dopiero raczkuje. Twoje zapytanie było dla mnie fajne, gdyż miałem okazję troszkę się pobawić z VBA.
Zmajstrowałem niezdarnie podobne rozwiązanie, ale co ważne działa. Sprawdź, może się Tobie przyda.
Pozdrawiam

WZ.xlsm

Pobierz Plik ściągnięto 4 raz(y) 29.62 KB