Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 08:41:23
Zwei Makros in ein Arbeitsblatt - zweite wird nicht ausführt
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
18.04.2024 19:30:20
VBA - Tabelle mit Mannschaftsergebnissen sortieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1044to1048
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1044to1048
1044to1048
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Spalte durchlaufen und Kriterium suchen

Spalte durchlaufen und Kriterium suchen
29.01.2009 21:55:00
Dieter
Hi
habe folgendes Problem: Ich möchte mit einem Makro Im Tabellenblatt "Ablage" die Spalte A durchlaufen und nach dem String "NETTO" (Nur die ersten 5 Zeichen prüfen) suchen
Wenn In der Spalte A ein Eintrag mit "NETTO" beginnt (zB "NETTOBETRAG" ) , soll in dieser Zeile nach einem String gesucht werden, der sich innerhalb der zwei Zeichen befindet. (zB. ).
Beispiel: Wenn in der Salte A "NETTO" gefunden wird, in dieser Zeile den String zwischen den Zeichen auslesen und in das Tabellenblatt "ERGEBNIS" in die Zelle C33 schreiben.
Die nächsten Zeilen nach "NETTO" durchsuchen und bei einem erneuten Fund wieder diese Zeile nach dem String zwischen suchen , auslesen und in das Tabellenblatt "ERGEBNIS" in die Zelle C34 schreiben.
Also eine Zelle unter dem ersten Fund.
und so alle Zeilen durcharbeiten und die Ergebnisse immer forlaufen auf Tabellenblatt "ERGEBNIS" ab C33 nach unten weiter schreiben. (C33, C34, C35usw.)
Wie kan man denn so eine Funktion schreiben. hat jemand ein Beispiel dazu. Falls mein Text nicht nachvollziebar ist, baue ich auch eine Beispieldatei.
Danke mal
Dieter

19
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spalte durchlaufen und Kriterium suchen
29.01.2009 22:10:00
Gerd
Hallo Dieter!
"Wenn In der Spalte A ein Eintrag mit "NETTO" beginnt (zB "NETTOBETRAG" ) , soll in dieser Zeile nach einem String gesucht werden, der sich innerhalb der zwei Zeichen befindet. (zB. )."
Kann man die Zeile ortsfest angeben, z.B. in den Spalten B - F dieser Zeile oder ähnlich ?
Oder steht der in Klammern gesetzte Ausdruck auch in Spalte A ?
Gruß Gerd
AW: Spalte durchlaufen und Kriterium suchen
29.01.2009 22:36:58
Dieter
Hi Gerd,
zuerst mal vergisss die zwei Zeichen , ich nehme []
zu Deiner ersten Frage:
"Wenn In der Spalte A ein Eintrag mit "NETTO" beginnt (zB "NETTOBETRAG" ) , soll in dieser Zeile nach einem String gesucht werden, der sich innerhalb der zwei Zeichen [] befindet. (zB. )."
JA, genau
zur zweiten Frage:
Also der String kann sich in dem Bereich A bis max. M , also ("A bis M"), befinden.
(also inclusive A)
Zeilen könne so aussehen:
A_________________________B______________C___________________D_________________E
NETTOBETRAG______________________________[FAHRRAD]
NETTOBETRAG__________________________________________________Bestellt. [FAHRRAD]
NETTOBETRAG [FAHRRAD]____________________________________________________________
Guss Dieter
Anzeige
Würde das ein Problem machen,wenn..
29.01.2009 22:41:13
Dieter
..sich der Inhalt innerhalb [ ] auch in der Spalte A befinden würde ?
GRuss
Dieter
Ein Problem bleibt noch,...
30.01.2009 00:46:03
Luc:-?
...Dieter!
So wie du das Bsp aufgeschrieben hast, sieht es fast so aus, als ob der Text nur in A stehen und sich nur wg Überlänge bis D bzw E erstrecken würde. Wenn das so sein sollte, wäre es besser, die Spalte A entsprechend zu verbreitern (nicht mit den anderen Spalten verbinden). Dann wäre alles eindeutig. In diesem Fall ließe sich das auch bequem mit Formeln lösen, evtl mit einer Hilfszelle zur Formeldynamisierung pro Ergebniszelle, also 2 Formeln pro Ergebnis.
Gruß Luc :-?
Besser informiert sein!
Anzeige
Formellösung mit Autofilter
29.01.2009 23:38:00
Beate
Hallo Dieter,
Hier eine Formellösung mit den Hilfsspalten N, O und P,
Die Spalten O und P kannst du ausblenden.
Spalte N kannst du nach Nichtleeren per Autofilter in Zeile 1 filtern.
Siehe: https://www.herber.de/bbs/user/58922.xls
Gruß,
Beate
Danke
30.01.2009 13:23:58
Dieter
Hallo Beate,
Danke, wenn es mit Makros nicht klappt, werden ich es mit einer Funktion versuchen.
Gruss
Dieter
VBA Lösung, zum testen
29.01.2009 23:50:26
Tino
Hallo,
hier eine VBA Lösung, kannst ja mal testen ob es funzt.
Sub Suche()
Dim Bereich As Range
Dim A As Long, B As Long
Dim Zelle As Range, CZelle As Range
Dim meAr(), LCount As Long

Set Bereich = Sheets("Ablage").Columns(1)

B = Application.WorksheetFunction.CountIf(Bereich, "NETTO*")

For A = 1 To B
 If A = 1 Then
     
     Set Zelle = Bereich.Find("NETTO*", , xlValues, 2, 1, 1, False, False)
     Set CZelle = Zelle.EntireRow.Find("[*", , xlValues, 2, 1, 1, False, False)
  
    If Not CZelle Is Nothing Then
      Redim Preserve meAr(LCount)
      meAr(LCount) = Right$(CZelle, Len(CZelle) - InStrRev(CZelle, "["))
      meAr(LCount) = Left$(meAr(LCount), InStr(meAr(LCount), "]") - 1)
      LCount = LCount + 1
    End If
 
 Else
    
    Set Zelle = Bereich.Find("NETTO*", Zelle, xlValues, 2, 1, 1, False, False)
    Set CZelle = Zelle.EntireRow.Find("[*", , xlValues, 2, 1, 1, False, False)
    
    If Not CZelle Is Nothing Then
      Redim Preserve meAr(LCount)
      meAr(LCount) = Right$(CZelle, Len(CZelle) - InStrRev(CZelle, "["))
      meAr(LCount) = Left$(meAr(LCount), InStr(meAr(LCount), "]") - 1)
      LCount = LCount + 1
    End If
 
 End If

Next A
 
With Sheets("ERGEBNIS")
 .Range(.Range("C33"), .Cells(.Rows.Count, 3).End(xlUp)).Value = ""
 .Range("C33").Resize(LCount) = Application.Transpose(meAr)
End With
End Sub


Gruß Tino

Anzeige
AW: VBA Lösung, zum testen
30.01.2009 13:21:00
Dieter
Hallo Tino,
vielen dank, das einlesen funktioniert :-)
Noch eine Frage: Ist es ein grosser aufwand, in der Zeile, wo ein Treffer gefunden wurde, dort aus der Spalte I den Inhalt rauszukopieren und dann im Sheet "Ergebnis" neben den ersten Eintrag(C33) in D33 wieder einfügen. Dann nochmal zurück zur gefundenen Zeilen auf Sheet "Ablage" und in der Gleichen Spalte (I) eine Zeile weiter untern den Wert nach "Ergebnis" E33 Kopieren.
Das gleiche auch wieder in einer Schleife alle Zeilen durch.
Ist sicher blöd zu erklären, schau dir mal das Beispiel an:
https://www.herber.de/bbs/user/58931.xls
ob dies Möglich ist.
Danke fürs Bemühen
Gruss
Dieter
Anzeige
AW: VBA Lösung, zum testen
30.01.2009 13:49:00
Tino
Hallo,
versuche es mal damit.
Sub Suche()
Dim Bereich As Range
Dim A As Long, B As Long
Dim Zelle As Range, CZelle As Range
Dim meAr(), LCount As Long

Set Bereich = Sheets("Ablage").Columns(1)

B = Application.WorksheetFunction.CountIf(Bereich, "NETTO*")
Redim meAr(B, 2)
For A = 1 To B
 If A = 1 Then
     
     Set Zelle = Bereich.Find("NETTO*", , xlValues, 2, 1, 1, False, False)
     Set CZelle = Zelle.EntireRow.Find("[*", , xlValues, 2, 1, 1, False, False)
  
    If Not CZelle Is Nothing Then
      meAr(LCount, 0) = Right$(CZelle, Len(CZelle) - InStrRev(CZelle, "["))
      meAr(LCount, 0) = Left$(meAr(LCount, 0), InStr(meAr(LCount, 0), "]") - 1)
      meAr(LCount, 1) = Sheets("Ablage").Cells(CZelle.Row, 4)
      meAr(LCount, 2) = Sheets("Ablage").Cells(CZelle.Row + 1, 4)
      LCount = LCount + 1
    End If
 
 Else
    
    Set Zelle = Bereich.Find("NETTO*", Zelle, xlValues, 2, 1, 1, False, False)
    Set CZelle = Zelle.EntireRow.Find("[*", , xlValues, 2, 1, 1, False, False)
    
    If Not CZelle Is Nothing Then
      meAr(LCount, 0) = Right$(CZelle, Len(CZelle) - InStrRev(CZelle, "["))
      meAr(LCount, 0) = Left$(meAr(LCount, 0), InStr(meAr(LCount, 0), "]") - 1)
      meAr(LCount, 1) = Sheets("Ablage").Cells(CZelle.Row, 4)
      meAr(LCount, 2) = Sheets("Ablage").Cells(CZelle.Row + 1, 4)
      LCount = LCount + 1
    End If
 
 End If

Next A
 
With Sheets("ERGEBNIS")
 .Range(.Range("C33"), .Cells(.Rows.Count, 3).End(xlUp).Offset(0, 2)).Value = ""
 .Range("C33").Resize(Ubound(meAr, 1), Ubound(meAr, 2) + 1) = meAr
End With
End Sub


Gruß Tino

Anzeige
Ergebnis weiterhin das gleiche
30.01.2009 14:37:55
Dieter
Hallo Tino,
habe Dein Code mal getestet. Im Prinzip ist alles noch so wie vorher. Es werden alle Strings, die sich zwischen den Zeichen [ und ] befinden gefunden und auch in das andere Sheet an die richtige stelle kopiert.
In den Spalten E und D aus "Ergebnis" , wo die Zahlen rein sollen, wird nichts eingefügt. bleibt leer.
Kannst Du nochmal drauf schauen ?
Danke Tino
Gruss
Dieter
AW: Ergebnis weiterhin das gleiche
30.01.2009 14:45:00
Tino
Hallo,
sage mir nochmal in welcher Spalte sich die Zahlen befinden,
in Deinem Beispiel waren diese in der Spalte D.
Gruß Tino
Spalte I hattest Du reingeschrieben
30.01.2009 14:56:35
Tino
Hallo,
versuche es nochmal, wo die Spalte für geändert wird habe ich kommentiert.
Sub Suche()
Dim Bereich As Range
Dim A As Long, B As Long
Dim Zelle As Range, CZelle As Range
Dim meAr(), LCount As Long

Set Bereich = Sheets("Ablage").Columns(1)

B = Application.WorksheetFunction.CountIf(Bereich, "NETTO*")
Redim meAr(B, 2)
For A = 1 To B
 If A = 1 Then
     
     Set Zelle = Bereich.Find("NETTO*", , xlValues, 2, 1, 1, False, False)
     Set CZelle = Zelle.EntireRow.Find("[*", , xlValues, 2, 1, 1, False, False)
  
    If Not CZelle Is Nothing Then
      meAr(LCount, 0) = Right$(CZelle, Len(CZelle) - InStrRev(CZelle, "["))
      meAr(LCount, 0) = Left$(meAr(LCount, 0), InStr(meAr(LCount, 0), "]") - 1)
      meAr(LCount, 1) = Sheets("Ablage").Cells(CZelle.Row, 9)       'Spalte für die Zahlen i = 9 
      meAr(LCount, 2) = Sheets("Ablage").Cells(CZelle.Row + 1, 9)   'Spalte für die Zahlen i = 9 
      LCount = LCount + 1
    End If
 
 Else
    
    Set Zelle = Bereich.Find("NETTO*", Zelle, xlValues, 2, 1, 1, False, False)
    Set CZelle = Zelle.EntireRow.Find("[*", , xlValues, 2, 1, 1, False, False)
    
    If Not CZelle Is Nothing Then
      meAr(LCount, 0) = Right$(CZelle, Len(CZelle) - InStrRev(CZelle, "["))
      meAr(LCount, 0) = Left$(meAr(LCount, 0), InStr(meAr(LCount, 0), "]") - 1)
      meAr(LCount, 1) = Sheets("Ablage").Cells(CZelle.Row, 9)       'Spalte für die Zahlen i = 9 
      meAr(LCount, 2) = Sheets("Ablage").Cells(CZelle.Row + 1, 9)   'Spalte für die Zahlen i = 9 
      LCount = LCount + 1
    End If
 
 End If

Next A
 
With Sheets("ERGEBNIS")
 .Range(.Range("C33"), .Cells(.Rows.Count, 3).End(xlUp).Offset(0, 2)).Value = ""
 .Range("C33").Resize(Ubound(meAr, 1), Ubound(meAr, 2) + 1) = meAr
End With
End Sub


Gruß Tino

Anzeige
AW: Spalte I hattest Du reingeschrieben
30.01.2009 16:16:54
Dieter
Hallo Tino,
habs getestet, scheint zu funktionieren. Hatte ich Dir eine falsche Spalte genannt ? SORRY, war mein Fehler.
Also, wie gesagt, das Einlesen funktioniert nun. nur noch eine kleineigkeit:
Kannst Du Dir vielleicht noch erklären, warum nun meine Überschriften im Blatt "ERGEBNIS" C31:C32 , D31:D32 und E31:32 gelöscht werden ?
Das sind genau die Spalten, wo das Endergebnis darunter in Zeile 33 eingefügt wird. Sollte der Code nicht erst bei Zeile 33 starten ?
Gruss
Dieter
AW: Spalte I hattest Du reingeschrieben
30.01.2009 16:33:10
Tino
Hallo,
ja weil ich den Bereich vorher leer mache, damit keine falschen Daten vorhanden sind.
Dies mache ich mit dieser Zeile:
.Range(.Range("C33"), .Cells(.Rows.Count, 3).End(xlUp).Offset(0, 2)).Value = ""
Versuch mal und mach aus dieser
.Range(.Range("C33"), .Cells(.Rows.Count, 5)).Value = ""
Gruß Tino
Anzeige
AW: Spalte I hattest Du reingeschrieben
30.01.2009 17:50:45
Dieter
Hallo Tino,
oben ist es nun iO, aber unten habe ich das Gleiche Problen. Daten die sich ab Zeile 44 befinden, werden ebenfalls gelöscht. Könntest Du Den Code bitte, bitte noch einmal so ändern , dass er nicht über die zeile 43 hinaus arbeitet. Mein Range, wo die Daten reinkopiert werden , ist eh blos max 10 Zeilen.
Die Formeln, die ab 44 kommen, sind sonst weg.
Oder sag mir , was ich änder muss
Am besten wäre es , deine Schleife würde nach dem 10 Eintrag automatisch mit einer Meldung stoppen.
Sorry.
Gruss
Dieter
AW: Spalte I hattest Du reingeschrieben
30.01.2009 18:03:00
Tino
Hallo,
das musst Du mir auch sagen, ich weis nicht wie Deine Tabelle aufgebaut ist.
Gleiche Zeile ersetzen durch diese
.Range("C33:E43").Value = ""
Gruß Tino
Anzeige
OK, passt, Danke
30.01.2009 18:37:00
Dieter
Hi Tino,
stimmt , hast recht, hätte ich auch gleich erwähnen, können. :-()
Also schönes WE
Gruss
Dieter
Was muss ich hier ändern ?
02.02.2009 20:52:00
Dieter
Hi,
Tino hatte mir den folgenden Code gemacht: 

Sub Suche()
Dim Bereich As Range
Dim A As Long, B As Long
Dim Zelle As Range, CZelle As Range
Dim meAr(), LCount As Long
Set Bereich = Sheets("Ablage").Columns(1)
B = Application.WorksheetFunction.CountIf(Bereich, "NETTO*")
Redim meAr(B, 2)
For A = 1 To B
If A = 1 Then
Set Zelle = Bereich.Find("NETTO*", , xlValues, 2, 1, 1, False, False)
Set CZelle = Zelle.EntireRow.Find("[*", , xlValues, 2, 1, 1, False, False)
If Not CZelle Is Nothing Then
meAr(LCount, 0) = Right$(CZelle, Len(CZelle) - InStrRev(CZelle, "["))
meAr(LCount, 0) = Left$(meAr(LCount, 0), InStr(meAr(LCount, 0), "]") - 1)
meAr(LCount, 1) = Sheets("Ablage").Cells(CZelle.Row, 9)       'Spalte für die Zahlen i =  _
9
meAr(LCount, 2) = Sheets("Ablage").Cells(CZelle.Row + 1, 9)   'Spalte für die Zahlen i =  _
9
LCount = LCount + 1
End If
Else
Set Zelle = Bereich.Find("NETTO*", Zelle, xlValues, 2, 1, 1, False, False)
Set CZelle = Zelle.EntireRow.Find("[*", , xlValues, 2, 1, 1, False, False)
If Not CZelle Is Nothing Then
meAr(LCount, 0) = Right$(CZelle, Len(CZelle) - InStrRev(CZelle, "["))
meAr(LCount, 0) = Left$(meAr(LCount, 0), InStr(meAr(LCount, 0), "]") - 1)
meAr(LCount, 1) = Sheets("Ablage").Cells(CZelle.Row, 9)       'Spalte für die Zahlen i =  _
9
meAr(LCount, 2) = Sheets("Ablage").Cells(CZelle.Row + 1, 9)   'Spalte für die Zahlen i =  _
9
LCount = LCount + 1
End If
End If
Next A
With Sheets("ERGEBNIS")
.Range(.Range("C33"), .Cells(.Rows.Count, 3).End(xlUp).Offset(0, 2)).Value = ""
.Range("C33").Resize(Ubound(meAr, 1), Ubound(meAr, 2) + 1) = meAr
End With
End Sub


Die Daten, die in der Ablage sind , befinden sich nicht mehr in Spalte A, sondern in D. (Hat sich was geändert.
Welchen Parameter muss ich denn wieder ändern, damit der Code nicht auf A sondern auf D zugreift ?
Danke
Dieter

Anzeige
Habs doch gefunden, danke oT
02.02.2009 21:09:00
Dieter

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige