Brauche Makro für...

Forumthread: Brauche Makro für...

21.08.2004 10:52:18

freemann58

Hallo!
Ich bräuchte mal eure Hilfe bei Makros.
Also ich denke, dass man Makros dafür brauch was ich vor habe. Ich bin mir da nicht so sicher.
Ich habe 2 Tabellenblätter.
In dem einem Tabellenblatt hab ich 2 Spalten. In der 1. Spalte stehen mehrere Artikelnummern und in der 2. Spalte steht die Anzahl der Artikel
zum Beispiel:
Spalte A
Artikelnummer
51684646
654165
Spalte B
5
3
Im 1. Tabellenblatt soll sowas wie ein Textfeld (wie bei Google und anderen Suchmaschinen ) . In diesem Textfeld wird dann eine Artikelnummer eingegeben und wenn ich auf Enter drücke soll
die Artikelnummmer gesucht werden und die Anzahl dieses Artikels soll sich um 1 verringern.
Weiß einer von euch wie man sowas macht ?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Brauche Makro für...

21.08.2004 12:30:07

Michi

Hallo,
hier der Code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Row = 1 And Target.Column = 2 And Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        Call Suche(Target.Text, ThisWorkbook.Worksheets(1).Range("D1").Value)
    End If

End Sub
Private Function Suche(ByVal strArtNr As String, ByVal intSubtrahent As Integer)

    Dim rngZelle As Range

    Set rngZelle = ThisWorkbook.Worksheets(2).Cells(1, 1).EntireColumn.Find( _
        What:=strArtNr, _
        After:=ThisWorkbook.Worksheets(2).Range("A1"), _
        LookIn:=xlFormulas, _
        LookAt:=xlWhole, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, _
        MatchCase:=True, _
        SearchFormat:=False)

    If Not rngZelle Is Nothing Then
        If rngZelle.Value > 0 Then
            ThisWorkbook.Worksheets(2).Cells(rngZelle.Row, rngZelle.Column + 1) = _
            ThisWorkbook.Worksheets(2).Cells(rngZelle.Row, rngZelle.Column + 1) - intSubtrahent
            If ThisWorkbook.Worksheets(2).Cells(rngZelle.Row, rngZelle.Column + 1) Then
                ThisWorkbook.Worksheets(2).Cells(rngZelle.Row, rngZelle.Column + 1) = 0
            End If
            Set rngZelle = Nothing
        End If
    End If

End Function

Siehe auch die Beispieldatei:
https://www.herber.de/bbs/user/9904.xls
Gruss
Michi

crossposting, von mir aus, ...

21.08.2004 12:43:30

mir

aber dann poste wenigstens das du ein ergebnis hast !
gruß
andreas e
http://www.office-loesung.de/viewtopic.php?t=15354&highlight=

AW: zur Vervollständigung

Michi

Komme gerade vom Einkaufen. Musste mich hier erstmal durchwühlen. Das war ja wohl kein Crossposting sondern ein "Rundruf an alle" (Foren) von Freeman58. ;)=)
@Freeman58:
Ich hatte dir doch eine Beispieldatei erstellt. Brauchste keine Ahnung von VBA für zu haben, um die zu benutzen.
Gruss
Michi

AW: zur Vervollständigung

freemann58

Danke für eure Antworten.
Ich habe jetzt die richtige Lösung.

Beliebteste Forumthreads (12 Monate)

Forumthread: Brauche Makro für...

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread