Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Wert in mehreren Tabellen suchen
02.08.2017 20:34:43
Thomas
Liebe Excelspezialisten!
ich benötige bitte wieder eure Hilfe.
Wie die Überschrift schon aussagt benötige ich einen Code, der in den Tabellen einer Excelarbeitsmappe nach einen Wert sucht. Die zu suchenden Werte befinden sich in der A-Spalte, und zwar beginnen bei A6. Es gibt 12 Tabellenblätter (Januar bis Dezember)
Die Suche soll dabei in dem Arbeitsblatt des aktuellen Monats beginnen und es sollen dabei der aktuelle Monat und die 2 vorhergehenden Monate durchsucht werden. Also im August in den A-Spalten (beginnend A6) der Tabellenblätter August - Juli - Juni nach einen Wert gesucht werden, den ich vorher in einer Inputbox eingegeben habe.
Wird der Wert gefunden, so soll in einer MsgBox ausgegeben werden, in welchem Tabellenblatt dieser gefunden wurde. Ich habe schon unten angegeben Code gebastelt, jedoch sucht dieser nur in der aktuell geöffneten Tabelle.
Wäre schön, wenn mir wer helfen kann.
Vielen Dank!!!!!
Sub suchen()
Dim suche As String
Dim z As String
suche = InputBox("wonach wollen Sie suchen?")
'Wert vorhanden
z = "bereits vorhanden"
'hier ändern falls eine andere Spalte durchsucht werden soll
[A6].Activate
'wenn keine Eingabe in InpuBox erfolgte wird abgebrochen
If suche = "" Then Exit Sub
'bis zur ersten leeren Zelle suchen
Do Until ActiveCell = ""
'eine Zeile nach unten gehen
ActiveCell.Offset(1, 0).Activate
'wenn die Zelle den gesuchten Wert enthält:
If ActiveCell = suche Then
MsgBox "Eintrag bereits vorhanden"
'und die Zelle gelb markieren
ActiveCell.Interior.ColorIndex = 36
End If
Loop
MsgBox "kein Eintrag gefunden"
End Sub

17
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Wert in mehreren Tabellen suchen
02.08.2017 23:51:46
Piet
Hallo Thomas
anbei dein eigener Code, nur abgeaendert. Ich benutze die Blatt Index Funktion.
Das klappt aber nur wenn die Blaetter in der Lauf Nummer hintereinander liegen!
Bitte mal ausprobieren ob es so klappt. So schaue ich nicht auf den Monats Text.
Wenn nicht kann man die Blaetter Reihenfole im VBA Editor neu anordnen.
mfg Piet
Sub Makro1()
Dim suche As String
Dim Zahl As Integer, j As Integer
suche = InputBox("wonach wollen Sie suchen?")
'wenn keine Eingabe in InpuBox erfolgte wird abgebrochen
If suche = "" Then Exit Sub
Zahl = ActiveSheet.Index   'Blatt Index ermitteln
'Schleife für 3 Blätter über Rückwärts Funktion (Step-1)
For j = Zahl To Zahl - 2 Step -1
'Blatt über Index anwählen
Worksheets(j).Select
'hier ändern falls eine andere Spalte durchsucht werden soll
[A6].Activate:  n = 0   'Zähler löschen
'bis zur ersten leeren Zelle suchen
Do Until ActiveCell = ""
'eine Zeile nach unten gehen
ActiveCell.Offset(1, 0).Activate
'wenn die Zelle den gesuchten Wert enthält:
If ActiveCell = suche Then
MsgBox "Eintrag bereits vorhanden"
'und die Zelle gelb markieren
ActiveCell.Interior.ColorIndex = 36
n = n + 1
End If
Loop
If n = 0 Then MsgBox "kein Eintrag gefunden"
If n > 0 Then MsgBox n & "  Einträge gefunden"
Next j
End Sub

Anzeige
AW: Wert in mehreren Tabellen suchen
03.08.2017 00:04:41
Piet
Hallo Thomas
mir ist gerade noch etwas ringefallen, einen Befehl denn man Vor Next j einfügen sollte:
If ActiveSheet.Name = "Januar" Then Exit For
damit man nicht weiter rückwaerst geht wenn der "Januar" erreicht wurde!
AW: Wert in mehreren Tabellen suchen
03.08.2017 07:08:59
Thomas
Hallo Piet!
vielen Danke!
Ich werde es heute ausprobieren.
VG Thomas
AW: Wert in mehreren Tabellen suchen
03.08.2017 17:02:43
Thomas
Hallo Piet!
Es funktioniert, aber bedingt.
Denn die Suche geht erst weiter, wenn ich auf der MsgBox auf OK klicke. Dann öffnet sich die Tabelle zuvor und sucht.
Es soll aber so sein, dass er den aktuellen Monat und die 2 davor sofort durchsucht.
Beispiel: Aktueller Monat August. Es öffnet sich z. B. eine Inputbox. Dort gebe ich den zu suchenden
Wert ein und klicke auf OK. Es werden dann die 3 Tabellen durchsucht (Aktueller Monat und die 2 zuvor).
Wird ein Eintrag gefunden, so soll in der MsgBox angezeigt werden, in welcher Tabelle der Wert gefunden wurde.
Anzeige
AW: Wert in mehreren Tabellen suchen
03.08.2017 20:15:57
Thomas
Hallo Piet!
Es funktioniert zum Teil, denn man muss erst immer auf die MsgBox klicken, erst dann wird im vorhergehenden Tabellenblatt durchsucht. Gedacht war es aber so. Ich bin jetzt im Tabellenblatt des aktuellen Monats, also August. In einer z. B. Inputbox soll der Suchwert eingegeben werden. Wenn man dann auf Enter klickt, so soll in August, Juli, Juni gesucht werden. Wird ein gesuchter Eintrag gefunden, so soll in einer MsgBox der Monat angezeigt werden, in der der gesuchte Eintrag gefunden wurde. Gibt es hierzu eine Lösung?
AW: Wert in mehreren Tabellen suchen
03.08.2017 23:09:43
Piet
Hallo Thomas
ich bin nicht staendig im Forum und habe jetzt erst deine Frage gesehen. Bin aber zu müde.
Schaue mir die Sache morgen in Ruhe an. Wir finden sicher eine Lösung.
mfg Piet
Anzeige
AW: Wert in mehreren Tabellen suchen
04.08.2017 07:02:23
Thomas
Hallo Piet!
Vielen Dank für deine Mühe!
AW: Wert in mehreren Tabellen suchen
04.08.2017 09:44:01
Piet
Hallo Thomas,
ich habe drei Makros im Angebot, das dritte als reine Demo für InputBox zum -selbst gestalten-
Das erste Makro gibt die Zeile mit an wo der Suchwert gefunden wurde, das zweite nur wie oft er vorkommt.
Die Tabelle wird dabei nicht veranedert, ich kann auch ohne Select zwei Monate rückwaerts schauen!
Wird der "Januar" erreicht endet das Programm automatisch. Falls nicht gewünscht diese Zeile löschen.
Unklar ist mir noch über welche Aktion die InputBox aufgerufen werden soll?
Hast du dafür einen Button, oder eine Zelle wo du einen bestimmten Text eingibst?
Test bitte mal ob es so laeuft wie es dir gefaellt. Den Start können wir noch klaeren.
mfg Piet

Sub Makro1_mitZeile()
Dim suche As String, Sht As String
Dim Zahl As Integer, j As Integer
Dim Zeile, n As Integer, z As Long
suche = InputBox("wonach wollen Sie suchen?")
'wenn keine Eingabe in InpuBox erfolgte wird abgebrochen
If suche = "" Then Exit Sub
Zahl = ActiveSheet.Index   'Blatt Index ermitteln
'Schleife für 3 Blätter über Rückwärts Funktion (Step-1)
For j = Zahl To Zahl - 2 Step -1
With Worksheets(j).Range("A6")
'Tabellen Name zum Anzeigen
Sht = Worksheets(j).Name
z = 0: n = 0   'Zähler löschen
Zeile = Empty  'Zeile löschen
'bis zur ersten leeren Zelle suchen
Do Until .Offset(z, 0) = ""
'wenn die Zelle den gesuchten Wert enthält:
If .Offset(z, 0) = suche Then
'gefundene Zeile ermitteln
Zeile = Zeile & .Offset(z, 0).Row & "/ "
'gefundene Zelle gelb markieren
.Offset(z, 0).Interior.ColorIndex = 36
n = n + 1
End If
z = z + 1
Loop
'bei Zeile "/" am Ende wieder abschneiden
If Right(Zeile, 2) = "/ " Then Zeile = Left(Zeile, Len(Zeile) - 2)
If n > 0 Then MsgBox Sht & " - " & n & " Einträge gefunden in Zeile:" & Chr(10) & Zeile
'Abbrechen wenn Monat Januar erreicht ist!!
If Sht = "Januar" Then Exit Sub
End With
Next j
End Sub
Sub Makro2_normal()
Dim suche As String, Sht As String
Dim Zahl As Integer, j As Integer
Dim n As Integer, z As Long
suche = InputBox("wonach wollen Sie suchen?")
'wenn keine Eingabe in InpuBox erfolgte wird abgebrochen
If suche = "" Then Exit Sub
Zahl = ActiveSheet.Index   'Blatt Index ermitteln
'Schleife für 3 Blätter über Rückwärts Funktion (Step-1)
For j = Zahl To Zahl - 2 Step -1
With Worksheets(j).Range("A6")
'Tabellen Name zum Anzeigen
Sht = Worksheets(j).Name
z = 0: n = 0   'Zähler löschen
'bis zur ersten leeren Zelle suchen
Do Until .Offset(z, 0) = ""
'wenn die Zelle den gesuchten Wert enthält:
If .Offset(z, 0) = suche Then
'gefundene Zelle gelb markieren
.Offset(z, 0).Interior.ColorIndex = 36
n = n + 1
End If
z = z + 1
Loop
If n > 0 Then MsgBox Sht & "  -  " & n & " Einträge gefunden"
'Abbrechen wenn Monat Januar erreicht ist!!
If Sht = "Januar" Then Exit Sub
End With
Next j
End Sub
Sub Makro3_Input_Demo()
Dim suche As String
'InputBox mit Suchwort und Überschrift Vorganbe:
suche = InputBox("wonach wollen Sie suchen?", , "Test A6  (Suchvorgabe)")
suche = InputBox("wonach wollen Sie suchen?", "Meine Überschrift: ...", "Test A6")
suche = InputBox("wonach wollen Sie suchen?" & Chr(10) & "geht auch zweizeilig !!", , "Hallo")
End Sub

Anzeige
AW: Wert in mehreren Tabellen suchen
04.08.2017 22:15:03
Thomas
Hallo Piet!
Zunächst einmal vielen für deine Mühen!
Der funktioniert noch nicht so. Denn ist z. B. im August und Juni der gleiche Wert, so gibt dein
Code nur den gefunden Wert im August an, jedoch wird der Wert im Juli nicht mehr mit in der MsgBox angegeben.
Die Eingabe soll so sein, dass, wenn man mit der Maus in der A-Spalte (sagen wir im Bereich A6:A20) klickt, sich eine UserForm oder eine Inputbox öffnet. Darin gibt man dann den Suchwert ein.
Es sollen dann der aktuelle Monat und die 2 davor vergangenen Monate (Tabellenblätter) nach den
Suchwert durchsucht werden. Die Treffer sollen dann in der MsgBox aufgelistet werden.
In diesen Fall. Wert gefunden im August Zeile 6 und Juli Zeile 17. Es könnte auch sein, dass der Wert im Juli und Juni gefunden werden kann. Dann soll es eben z. B heißen: Wert im Juli Zeile 5 und Juni Zeile 10 gefunden. Wird kein Wert gefunden soll es heißen: kein Wert gefunden.
Aber du bist schon nahe dran!!!
Ich denke du weißt, was ich meine.
Vielen Dank Piet!!!
Anzeige
AW: Wert in mehreren Tabellen suchen
04.08.2017 22:18:51
Thomas
Noch zur Ergänzung.
Man soll dabei nur 1 x klicken, dann soll nach den Wert in den Tabellenblättern gesucht werden und die Treffer in einer MsgBox gelistet werden.
AW: Wert in mehreren Tabellen suchen
04.08.2017 22:19:01
Thomas
Noch zur Ergänzung.
Man soll dabei nur 1 x klicken, dann soll nach den Wert in den Tabellenblättern gesucht werden und die Treffer in einer MsgBox gelistet werden.
AW: Wert in mehreren Tabellen suchen
05.08.2017 09:46:01
Piet
Hallo Thomas
ich denke jetzt haben wir eine Lösung, wobei du selbst entscheiden kannst wo du das Makro ablegst.
In der ersten Version habe ich das Makro berichtigt und es komplett ins Modulblatt für: ThisWorbook - Diese Mappe mit integriert.
Man kann auch die untere Version nehmen, das Makro im Modulblatt belassen, und es über Call aufrufen.
Ich musste auf ThisWorkbook gehen, damit jeder Monat das Makro aufrufen kann. Wenn diese Funktion bei
einigen Blaettern störend ist musst du noch ein Exit Sub ins Makro einfügen. s. Beispiel für: -Sheet "Planung"-
mfg Piet

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column > 1 Or Target.Row  20 Then Exit Sub
İf Worksheet.Name = "Planung" then Exit Sub  'Unerwünschte Blaetter Exit Sub !!
'Sub Monat_Such_InputBox
Dim SArry(3, 3) As String  'Array
Dim suche As String, Txt As String
Dim Indx, j As Integer, FTxt As String
Dim n As Integer, m As Integer, z As Long
suche = InputBox("wonach wollen Sie suchen?")
'wenn keine Eingabe in InpuBox erfolgte wird abgebrochen
If suche = "" Then Exit Sub
Indx = ActiveSheet.Index   'Blatt Index ermitteln
'Schleife für 3 Blätter über Rückwärts Funktion (Step-1)
For j = Indx To Indx - 2 Step -1
With Worksheets(j).Range("A6")
FTxt = Empty  'Clr Find Text
z = 0: n = 0  'Zähler löschen
m = m + 1     'Monats Zaehler
'Tabellen Name zum Anzeigen
Txt = Worksheets(j).Name
SArry(m, 0) = Txt & ":" & Space(11 - Len(Txt))
If Len(Txt)  "" Then SArry(0, m) = " Zeile  " & FTxt
'Abbrechen wenn Monat Januar erreicht ist!!
If Sht = "Januar" Then Exit Sub
End With
Next j
'Auswertung nach Suchlauf:
Txt = SArry(1, 0) & SArry(0, 1)
Txt = Txt & Chr(10) & SArry(2, 0) & SArry(0, 2)
Txt = Txt & Chr(10) & SArry(3, 0) & SArry(0, 3)
MsgBox "gefunden:" & Chr(10) & Txt
End Sub
'zweite Vewrsion:
'Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'If Target.Column  1 Then Exit Sub
'If Target.Row >= 6 Or Target.Row 

Anzeige
AW: Wert in mehreren Tabellen suchen
05.08.2017 11:37:32
Thomas
Hallo Piet!
Ich hab es getestet. Es passt noch nicht ganz.
Denn ich muss immer noch nach der 1. MsgBox Meldung auf OK klicken, erst dann wird die nächste Mappe durchsucht.
Es soll aber so sein, dass beim 1. OK-klick gleich alle Tabellen(aktuell und 2 zuvor) durchsucht werden.
Dann soll die Meldung kommen, z. B., Wert gefunden in Monat x Zeile y. Werden 2 Werte gefunden, dann
Wert gefunden in Monat x Zeile y
Wert gefunden in Monat x Zeile y
Bei sowas ähnlichem hat man mir hier auch schon mal geholfen, nur komplexer, da hier nach Einträgen in Arbeitsmappen gesucht wurden, die sich in einen anderen Laufwerk befanden.
Vielleicht hilft dir der Quellcode weiter, denn mir gelingt es einfach nicht es so nur auf die Tabellenblätter abzuändern, obwohl es einfacher ist. Ich brauche keinen Pfad und kein Datum.
Sub sbMsgBox()
Dim lstrStart As String, lstrEnd As String, ldtDays As Date, lstrMsgBox As String, _
lstrPath As String
Dim larCur() As Variant, larFile() As Variant, liIdxCur As Integer, liIdxFile As Integer
Dim strFileSuch As String, strFile As String
Dim wkbTrans As Workbook
With ufDate
lstrStart = .cmbStD.Text & "." & .cmbStM.Text & "." & .cmbStY.Text
lstrEnd = .cmbEdD.Text & "." & .cmbEdM.Text & "." & .cmbEdY.Text
End With
If CDate(lstrStart) > CDate(lstrEnd) Then
MsgBox "Das Start-Datum ist größer als das End-Datum." & vbCrLf _
& "Bitte korrigieren", _
vbExclamation, "Hinweis"
Exit Sub
End If
Application.ScreenUpdating = False
lstrPath = "D:\Buchungen\" 'anpassen, wenn erforderlich!
lstrPath = IIf(Right(lstrPath, 1) = "\", lstrPath, lstrPath & "\")
For ldtDays = CDate(lstrStart) To CDate(lstrEnd)
'Datei-Suchstring für Dateisuche mit Funktion Dir
strFileSuch = "Transfer - " & Format(ldtDays, "DD.MM.YY") & " ?.?.xlsx"
'Datei(en) suchen
strFile = Dir(lstrPath & strFileSuch, vbNormal)
Do Until strFile = ""
larCur = Range("C2:G" & Cells(Rows.Count, 3).End(xlUp).Row)
'Datei schreibgeschützt öffnen
Set wkbTrans = Workbooks.Open(lstrPath & strFile, ReadOnly:=True)
With wkbTrans.Worksheets(1)
larFile = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp).Offset(0, 4)).  _
_
Value2
End With
wkbTrans.Close False
For liIdxCur = 1 To UBound(larCur, 1)
For liIdxFile = 1 To UBound(larFile, 1)
If larCur(liIdxCur, 1) = larFile(liIdxFile, 1) And _
larCur(liIdxCur, 5) = larFile(liIdxFile, 5) Then
lstrMsgBox = lstrMsgBox & "Datei ''" _
& ThisWorkbook.Name & "'', Zeile " & liIdxCur + 1 _
& " gefunden in Datei ''" & strFile & "'', Zeile " _
& liIdxFile + 1 _
& " Betrag: " & larFile(liIdxFile, 5) & " €" & vbCrLf
End If
Next
Next
'nächste Datei suchen
strFile = Dir
Loop
Next
Application.ScreenUpdating = True
If lstrMsgBox = "" Then
MsgBox "Es existieren keine Dateien mit Namen aus dem angegebenen Datumsbereich.", _
vbExclamation, "Hinweis"
Exit Sub
Else
uf_Meldung.lbl_Text = lstrMsgBox
uf_Meldung.Show
End If
End Sub

Anzeige
AW: Wert in mehreren Tabellen suchen
05.08.2017 12:01:36
Piet
Hallo Thomas,
das zuletzt geschickte Makro lief bei mir einwandfrei. Der Code muss in das Modul für "ThisWorkbook" kopiert werden.
Es startet automatisch, bei Zelle anklicken im Bereich "A6:A20"
Kann es sein das bei dir das alte Makro wieder startet? Denn im neuen gibt es ein Array für alle drei Tabellen, wo es sich notiert in welchen Zeilen die Werte vorkommen. Das Ergebnis wird auch nur einmal angezeigt! Wenn die MsgBox mehrfach erscheint laeuft auf jeden Fall das alte Makro! Im Zweifelsfall eine Kopie Datei anlegen und das alte Modul komplett löschen.
mfg Piet
hier naoch mal die ersten Zeilen des neuen Makros:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Column > 1 Or Target.Row  20 Then Exit Sub
İf Worksheet.Name = "Planung" then Exit Sub  'Unerwünschte Blaetter Exit Sub !!  

Anzeige
AW: Wert in mehreren Tabellen suchen
05.08.2017 12:09:50
Thomas
Hallo Piet!
Du hast recht. Der Code funktioniert einwandfrei. Ich hatte das Modul nicht gelöscht!!
Vielen Dank für deine Hilfe!!!
Das Forum ist klasse!!!
AW: Wert in mehreren Tabellen suchen
05.08.2017 12:17:59
Piet
Danke, freut mich
kleiner Tipp noch, bitte noch im Code mit einfügen: - Innenfarbe löschen vergessen !!
die Innenfarbe sollte immer gelöscht werden, sonst müllst du dir das Blatt mit alter Farbe zu!
mfg Piet
For j = Indx To Indx - 2 Step -1
With Worksheets(j).Range("A6")
FTxt = Empty  'Clr Find Text
z = 0: n = 0  'Zähler löschen
m = m + 1     'Monats Zaehler
'Innenfarbe im aktiven Blatt löschen
Worksheets(j).Columns(1).Interior.ColorIndex = xlNone
'Tabellen Name zum Anzeigen
Txt = Worksheets(j).Name    'mit Space Ausgleich
SArry(m, 0) = Txt & ":" & Space(11 - Len(Txt))
If Len(Txt) 

Anzeige
AW: Wert in mehreren Tabellen suchen
06.08.2017 11:27:13
Thomas
Hallo Piet!
Danke für den Hinweis.
Nachdem die gefundenen Werte ja in einer MsgBox angegeben werden benötige ich die Markierung nicht mehr.
Ich hab sie rausgelöscht.
Ansonsten funktioniert alles einwandfrei.
vielen Dank für deine Mühe!!!!!!
VG
Thomas

177 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige