ich habe in einer Tabelle über die Spalten C bis AH
ArtNr verteilt und möchte jetzt per Makro die Möglichkeit
haben einen best. Artikel zu suchen. Dieses Makro möchte ich
dann hinter einen Button legen :-)
Hat dazu jemand eine Idee ?
:-)Gruß
Ralf
Sub Ralf()
Dim SuBe As Range, _
s As String, _
laR As Long, _
i As Byte
s = InputBox(vbCr & vbCr & vbCr & "Artikelnummer eingeben:", _
"Artikelnummer suchen")
If StrPtr(s) = 0 Then
MsgBox "Sie haben ""Abbrechen"" gedrückt !" & vbCr & vbCr & _
" Das Makro wird abgebrochen !", vbOKOnly + vbCritical, _
"Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
ElseIf s = "" Then
MsgBox "Sie haben keine Eingabe gemacht !" & vbCr & vbCr & _
" Das Makro wird abgebrochen !", vbOKOnly + vbCritical, _
"Dezenter Hinweis für " & Application.UserName & ":"
Exit Sub
End If
laR = Cells(Rows.Count, 3).End(xlUp).Row
For i = 4 To 34
If Cells(Rows.Count, i).End(xlUp).Row > laR Then
laR = Cells(Rows.Count, i).End(xlUp).Row
End If
Next i
Set SuBe = Range("C1:AH" & laR).Find(What:=s, _
After:=Range("AH" & laR), LookAt:=xlWhole)
If Not SuBe Is Nothing Then
MsgBox "Artikelnummer '" & s & "' in Zelle '" & _
SuBe.Address(False, False) & "' gefunden !", 64, _
"Artikelnummer gefunden !"
Set SuBe = Nothing
Else
MsgBox "Artikelnummer '" & s & "' nicht gefunden !", 48, _
"Dezenter Hinweis für " & Application.UserName & ":"
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SuBe As Range, _
s As String, _
laR1 As Long, laR2 As Long, Gs As Long, Mm As Long, Ub As Long
If Target.Column <> 3 Then Exit Sub
s = Cells(Target.Row, 3).Text
laR1 = Cells(Rows.Count, 2).End(xlUp).Row
Gs = Worksheets.Application.SumIf(Range("C2:C" & laR1), _
s, Range("B2:B" & laR1))
With Sheets("Tabelle2")
laR2 = .Cells(Rows.Count, 1).End(xlUp).Row
Set SuBe = .Range("A1:A" & laR2).Find(What:=s, _
After:=.Range("A" & laR2), LookAt:=xlWhole)
If Not SuBe Is Nothing Then
Mm = SuBe.Offset(0, 3).Value
Set SuBe = Nothing
Else
MsgBox "KST '" & s & "' nicht gefunden !", 64, _
"Dezenter Hinweis für " & Application.UserName & ":"
End If
End With
If Gs > Mm Then
Ub = Gs - Mm
MsgBox "MaxMenge der KST " & s & " ist um " & Ub & " überschritten !", _
48, "Dezenter Hinweis für " & Application.UserName & ":"
End If
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen