Wie suche ich nach einem bestimmten Zelleninhalt ? - VBA

Question

Hallo liebe VBA-Profis,

ich möchte gerne den Inhalt (z.B. nach einem bestimmten Namen) einer bestimmten
Zelle in einer CSV Datei suchen und den Inhalt der rechten Nachbarzelle der
gesuchten Zelle oder die 2. rechte Nachbarzelle auslesen und in der Makro-datei
auflisten.

Könnt ihr mir weiterhelfen?

Besten Dank im Vorwege!

Viele Grüße
Flo_DF

Answer 1

Hallo Flo,

schau mal, ob das folgende Makro so klappt, wie du dir das vorstellst:

Sub suchenneu()

Dim strPfad As String
Dim Datei As Variant
Dim Quelle As String
Dim rngZelle As Range
Dim lngZeile As Long
Dim lngSpalte As Long
Dim vInhalt As Variant
Dim bAuslesen As Boolean
Dim lngz As Long
Dim strInhalt As String

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Erst der Pfad - anpassen
strPfad = "C:\Test\"
Datei = Dir(strPfad & "*.csv")

'Schleife für alle csv-Dateien im aktuellen Verzeichnis
Do While Len(Datei)

'ausgewählte Datei öffnen
Workbooks.Open (strPfad & Datei)

'Quelldatei festlegen
Quelle = ActiveWorkbook.Name 'geöffnete Datei
'Zähler für Spalte zurück setzen
lngSpalte = 0
'erste freie Zeile in Tabelle Auswertung ermitteln
lngZeile = ThisWorkbook.Worksheets("Auswertung").Cells(Rows.Count, 1).End(xlUp).Row + 1

'geöffnete Datei durchsuchen
For Each rngZelle In Workbooks(Quelle).Worksheets(1).UsedRange
'Inhalt wird eingelesen und aufgeteilt; Unterscheidungsmerkmal hier Semikolon, ggf. anpassen
vInhalt = Split(rngZelle.Value, ";")
'Prüfen ob in erstem Feld der Begriff Menge steht
If vInhalt(0) = "Menge" Then
'Schalter für Auslesen weiterer Datensätze auf Wahr setzen
bAuslesen = True
'Zeile wird in Variable geschrieben
lngz = rngZelle.Row
'Zähler für Spalte wird um eins erhöht
lngSpalte = lngSpalte + 1
End If
'Falls im ersten Feld High steht ..
If vInhalt(0) = "High" Then
'Schalter auf Falsch setzen
bAuslesen = False
'letzten Zeilenumbruch entfernen
strInhalt = Left(strInhalt, Len(strInhalt) - 1)
'Inhalt der Variable in Tabelle Auswertung schreiben
ThisWorkbook.Worksheets("Auswertung").Cells(lngZeile, lngSpalte) = strInhalt
'Variable StrInhalt auf leer setzen
strInhalt = ""
End If

'Inhalte in Variable schreiben
If bAuslesen = True And rngZelle.Row > lngz Then strInhalt = strInhalt & vInhalt(0) & vbLf

Next rngZelle

'geöffnete Datei wieder schließen ohne zu speichern
Workbooks(Quelle).Close False

Datei = Dir
Loop

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Gruß

M.O.

Answer 2

Hallo M.O.,

vielen Dank, dass du dich nochmal hintergeklemmt hast.

Wenn ich dein Script ausführe, bekomme ich zwar keine Fehlermeldung, aber auch kein Ergebnis. Er ließt nichts aus.

Den Pfad habe ich angepasst. Die CSV Dateien liegen im Folder von der Zieldatei mit dem Sheet Auswertung.

Dein Script starte ich aus der Zieldatei heraus.

Ich habe testweise dem Zielsheet "Auswertung" einen anderen Namen "Tabelle1" gegeben.

Er müsste doch sofort einen Fehler auswerfen, da er die Zieldatei mit Auswertung nicht findet.

Im anderen Script erhalte ich sofort eine Fehlermeldung.

Daher gehe ich davon aus, dass das Makro momentan nichts ausliest.


Wo ist mein Fehler?


LG
Flo

Answer 3

Hallo Flo,

das deutet darauf hin, dass deine CVS-Dateien nicht so aufgebaut sind, wie du beschrieben hast:

Es soll nun die gesamte Spalte A zwischen den Werten "Menge" und "High", die sich in Spalte A befinden

Daher wird nur das erste Element eines jeden Datensatzes einer CVS-Datei geprüft, ob Menge oder High darinsteht. Nur wenn dann High gefunden wird, werden die gefundenen Daten in das Arbeitsblatt "Auswertung" geschrieben. Wird High nicht in Spalte A gefunden, wird nichts in deine Zieltabelle geschrieben, uns es kommt keine Fehlermeldung, wenn du das Blatt im Makro umbenennst.

Also poste doch mal ein paar Beispielzeilen einer deiner CVS-Dateien (mit Texteditor öffnen!), möglichst mit Menge und oder High. Sensible Daten kannst du ja durch ein paar Dummy-Daten ersetzen.

Gruß
M.O.

Answer 4

Hallo M.O. :)

anbei ein Beispiel der CSV-Datei:

xxx

xxxx

xxxx 15

xxxxxx
xxxx






Menge Artikel-Nr. Artikelbezeichnung Einzelpreis Preis

8 C525 Buch1 x,xx € x,xx €


8 C526 Buch2 x,xx € x,xx €




Zwischensumme: x,xx €

Versandkosten: 0,00 €

inkl. Keine Steuer: 0,00 €

Rechnungsbetrag: x,xx €


High Name - xxx Tel.: 123
xxxx Fax: 1234
xxxx xx
xxxxx 3
xxxxx
xxxx
###########################################################################


Ich möchte, dass das Script die 8 und 8, die sich in Spalte A befinden,in Spalte A der Zieldatei Auswertung einließt und die Spalte B mit
C525 und C526 in Spalte B der Zieldatei Auswertung.

Es gibt CSV Dateien die zum Teil die Abschnitte Menge-High mehrmals vorkommen. Diese sollte dann beim Einlesen auch
berücksichtigt werden.

VG
FLO

Answer 5

Hallo Flo,

einerseits ist mir jetzt klarer, was du willst. Anderseits bin ich mir jetzt unsicher, wie die CSV-Datei genau aufgebaut ist. Lade mal eine Beispieldatei (mit Dummy-Daten, der Aufbau sollte aber der richtigen CSV-Datei entsprechen) auf einem Hoster deiner Wahl (z.B. hier) hoch und poste den Link hier mal.

Gruß

M.O.

Answer 6

Hallo M.O. & Community,

ich nehme nun einen anderen Ansatz, der wohl viel leichter ist, jedoch erhalte ich einen Scriptfehler:

########################################################

'Wert aus geöffneter Datei aus dem Tabellenblatt 1 aus Zelle _
A25:A58 und A102:A137 oder A25:A:58 in die erste freie Zelle in Spalte A übertragen
If Range("A65536").End(xlUp).Row > 100 Then
wksAuswertsheet.Cells(lngFirstFreeRow, 1) = _
Workbooks(objDatei.Name).Sheets(1).Range("A25:A58") & " " & _
Workbooks(objDatei.Name).Sheets(1).Range("A102:A137")
Else
wksAuswertsheet.Cells(lngFirstFreeRow, 1) = _
Workbooks(objDatei.Name).Sheets(1).Range("A25:A58")
End If


##########################################################

Ich möchte mit dem Script sagen, dass wenn die letzte beschriebene Zeile in Zeile 100 und mehr befindet dann soll er mir 2 Bereiche
ausgeben, ansonsten nur den Bereich A25:A58.

Die 100 ist wohl ein Value und nicht die Anzahl der Zeile. Daher wohl auch der Fehler.

Kann mir jmd. weiterhelfen?

LG Flo

Answer 7

Hallo Flo,

du kannst die Bereich nicht zusammenfassend kopieren, das musst du einzeln machen. Beispiel:

Sub kopieren()

Dim strPfad As String
Dim Datei As Variant
Dim Quelle As String
Dim lngZeile As Long
Dim lngQZeile As Long

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Erst der Pfad - anpassen
strPfad = "C:\Test\"
Datei = Dir(strPfad & "*.csv")

'Schleife für alle csv-Dateien im aktuellen Verzeichnis
Do While Len(Datei)

'ausgewählte Datei öffnen
Workbooks.Open (strPfad & Datei)

'Quelldatei festlegen
Quelle = ActiveWorkbook.Name 'geöffnete Datei
'letzte Zeile CVS-Datei ermitteln
lngQZeile = Workbooks(Quelle).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

If lngQZeile < 100 Then
'erste freie Zeile in Tabelle Auswertung ermitteln
lngZeile = ThisWorkbook.Worksheets("Auswertung").Cells(Rows.Count, 1).End(xlUp).Row + 1
Workbooks(Quelle).Worksheets(1).Range("A25:A58").Copy Destination:=ThisWorkbook.Worksheets("Auswertung").Cells(lngZeile, 1)
Else
'erste freie Zeile in Tabelle Auswertung ermitteln
lngZeile = ThisWorkbook.Worksheets("Auswertung").Cells(Rows.Count, 1).End(xlUp).Row + 1
Workbooks(Quelle).Worksheets(1).Range("A25:A58").Copy Destination:=ThisWorkbook.Worksheets("Auswertung").Cells(lngZeile, 1)
'erste freie Zeile in Tabelle Auswertung ermitteln
lngZeile = ThisWorkbook.Worksheets("Auswertung").Cells(Rows.Count, 1).End(xlUp).Row + 1
Workbooks(Quelle).Worksheets(1).Range("A102:A137").Copy Destination:=ThisWorkbook.Worksheets("Auswertung").Cells(lngZeile, 1)
End If

'geöffnete Datei wieder schließen ohne zu speichern
Workbooks(Quelle).Close False

Datei = Dir
Loop

End Sub

Wenn du eine CSV-Datei in Excel öffnest, dann wird diese anhand der Trennzeichen in einzelne Spalten aufgeteilt. Aber wenn du über VBA kopierst, dann gibt es dort keine Spalten. Deine kopierte Spalte A sieht dann z.B. so aus:
Beispieltext1;Zeile B;Wert;Zahl;Was weiß ich;Ende;;;
(Daher meine Bitte aus Antwort 13, eine CSV-Datei mit einem Texteditor zu öffenen und ein Beipiel zu posten).

Gruß

M.O.

Answer 8

Hallo Florian,

daher dieser Vorschlag:

Sub kopieren2()

Dim strPfad As String
Dim Datei As Variant
Dim Quelle As String
Dim lngZeile As Long
Dim lngQZeile As Long
Dim i As Long
Dim vInhalt As Variant

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Erst der Pfad - anpassen
strPfad = "C:\Test\"
Datei = Dir(strPfad & "*.csv")

'Schleife für alle csv-Dateien im aktuellen Verzeichnis
Do While Len(Datei)

'ausgewählte Datei öffnen
Workbooks.Open (strPfad & Datei)

'Quelldatei festlegen
Quelle = ActiveWorkbook.Name 'geöffnete Datei
'letzte Zeile CVS-Datei ermitteln
lngQZeile = Workbooks(Quelle).Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row


For i = 25 To 58
'erste freie Zeile in Tabelle Auswertung ermitteln
lngZeile = ThisWorkbook.Worksheets("Auswertung").Cells(Rows.Count, 1).End(xlUp).Row + 1
vInhalt = Split(Workbooks(Quelle).Worksheets(1).Cells(i, 1), ";")
ThisWorkbook.Worksheets("Auswertung").Cells(lngZeile, 1) = vInhalt(0)
Next i

If lngQZeile > 100 Then

For i = 102 To 137
'erste freie Zeile in Tabelle Auswertung ermitteln
lngZeile = ThisWorkbook.Worksheets("Auswertung").Cells(Rows.Count, 1).End(xlUp).Row + 1
vInhalt = Split(Workbooks(Quelle).Worksheets(1).Cells(i, 1), ";")
ThisWorkbook.Worksheets("Auswertung").Cells(lngZeile, 1) = vInhalt(0)
Next i

End If

'geöffnete Datei wieder schließen ohne zu speichern
Workbooks(Quelle).Close False

Datei = Dir
Loop

End Sub

Gruß

M.O.