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