mittels VBA "msgbox eingabe" eine Zahl suchen

Hallo liebe Excel Freunde
Ich habe hier eine Routine Aufgabe und möchte diese gerne automatisieren.
vielen Dank vorab für euer Feedback
Hier das File um was es geht:
https://www.herber.de/bbs/user/104662.xlsm
Dies ist ein Auszug aus dem SAP und kann je nach dem von der Datenmenge variieren.
In diesem File möchte ich folgende Schritte durchführen:
Blatt "Rohdaten"
1. Spalte B aufsteigend sortieren
2. Spalte E aufsteigen sortieren
3. msgbox soll erscheinen wobei ich eine Zahl eingeben will
4. Nach dieser Zahl soll nun in der Spalte A gesucht werden um folgende Aktion durchführen "diese Zahl kommt mehrmals vor"
5. Die Zahl wurde nun in der Spalte A gefunden, nun sollen die 10 Reihen oben und unten markiert (siehe im Excel bsp.1) und in das Blatt "Übersicht kopiert werden.
Die Daten in Spalten A im Blatt "Übersicht" sollten auch gleich geschrieben werden.
6. Dieses Vorgehen soll das Makro nun solange wiederholen, bis keine Zahl mehr gefunden wird.
ist das möglich?
vielen Dank
Gruss
Michel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro2() Dim Suche$, TB2, c, firstAddress, LR2& Set TB2 = Sheets("Übersicht") With ActiveWorkbook.Worksheets("Rohdaten") With .Sort .SortFields.Clear .SortFields.Add Key:=Range("B:B"), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortTextAsNumbers .SortFields.Add Key:=Range("E:E"), SortOn:=xlSortOnValues, _ Order:=xlAscending, DataOption:=xlSortTextAsNumbers .SetRange Range("A:I") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Suche = InputBox("Auftragsnummer ?", "Suchen") Set c = .Range("A:A").Find(Suche, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do If c.Row firstAddress End If End With End Sub

Hi Michel
Und noch eine Variante:

Sub Mach()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim iZeile As Long, letzteZeile As Long, tempZeile As Long
Dim vInput As Variant, minZeile As Long
Set WS1 = Worksheets("Rohdaten")
Set WS2 = Worksheets("Übersicht")
WS2.Cells.Delete  'optional Übersicht vorher leeren
With WS1.AutoFilter.Sort
.SortFields.Clear
.SortFields.Add Key:=WS1.Columns(2), SortOn:=xlSortOnValues, Order:=xlAscending
.SortFields.Clear
.SortFields.Add Key:=WS1.Columns(5), SortOn:=xlSortOnValues, Order:=xlAscending
End With
vInput = Application.InputBox("Bitte Zahl eingeben:", "Suche")
If vInput = False Then Exit Sub
If IsNumeric(vInput) Then
If WorksheetFunction.CountIf(WS1.Columns(1), vInput) = 0 Then
MsgBox "Zahl ist nicht vorhanden"
Else
WS1.Rows(1).Copy WS2.Rows(1) ' optional Überschriften kopieren
letzteZeile = WS1.Cells(WS1.Rows.Count, 1).End(xlUp).Row
For iZeile = 2 To letzteZeile
If WorksheetFunction.CountIf(WS1.Range(WS1.Cells(iZeile, 1), _
WS1.Cells(letzteZeile, 1)), vInput) = 0 Then Exit For
tempZeile = Application.Match(vInput, WS1.Range(WS1.Cells(iZeile, 1), _
WS1.Cells(letzteZeile, 1)), 0) + iZeile - 1
If tempZeile

cu
Chris

Beliebteste Forumthreads (12 Monate)

mittels VBA "msgbox eingabe" eine Zahl suchen

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

328 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

mittels VBA "msgbox eingabe" eine Zahl suchen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

328 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread