Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zeilen markieren wenn bestimmter Wert enthalten

Zeilen markieren wenn bestimmter Wert enthalten
05.12.2012 14:42:28
Jan
Hallo,
durch die Google-Suche bin ich auf dieses Forum aufmerksam geworden. Suche seit nach Stunden einer einfachen Makro-Lösung Zeilen mit einem bestimmten Wert zu markieren (leider fehlt mir selbst das Know-How in diesem Bereich). Vielleicht kann mir jemand helfen, bin bislang nur über ähnliche Probleme gestolpert und die machen mir dann nur alles bunt etc.
Spalte A ....
2: ABC_1 .....
3: ABC_1 .....
4: ABC_2 .....
5: ABC_2 .....
6: ABC_2 .....
7: ABC_3 .....
.
.
.
In diesem Fall sollen also die Zeilen 2+3 markiert werden (die möchte ich dann in eine neue Excel-Tabelle kopieren und unter dem Namen ABC_1 speichern). Dann soll es weitergehen mit den Zeilen 4-6 (abgespeichert unter ABC_2) usw.
Freue mich über jede Hilfe, da es kurzfristig ist und ich mir erst nochmal ein VB-Buch zulegen muss ;)

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zeilen markieren wenn bestimmter Wert enthalten
05.12.2012 15:41:06
Klaus
Hi Jan,
hab da mal kurz was gestrickt.
Bitte achte darauf, dass alle deine Dateinamen auch gültig sind, sonst schmierts ab! (also keine Sonderzeichen oder so)
Grüße,
Klaus M.vdT.
Option Explicit
Sub SaveManyFiles()
Dim iCol As Integer
Dim wksOld As Worksheet
Dim sPath As String
'Umbenennen! Wird bei dir ja nicht "Tabelle1" heissen
Set wksOld = Sheets("Tabelle1")
'Hier die SPALTE angeben in der die nächsten Dateinamen stehen! A = 1, B = 2
iCol = 1
'Hier werden die neuen Dateien gespeichert
sPath = "C:\TestTMP"
'Hier fängt der Code an!
Dim rDatei As Range
Dim lRowLast As Long
Dim lAnzDatei As Long
Dim wkbOld As Workbook
Dim wkbNew As Workbook
With wksOld
lRowLast = .Cells(Rows.Count, iCol).End(xlUp).Row                                            _
'letzte Zeile
For Each rDatei In Range(Cells(2, iCol), Cells(lRowLast, iCol))                              _
'für den Bereich
lAnzDatei = Application.WorksheetFunction.CountIf(.Cells(1, iCol).EntireColumn, rDatei. _
Value) 'so viele Datensätze dieses Names gibt es
If rDatei = "" Then                                                                      _
'wenn leer dann nix! (Leer wenn gelöscht, siehe unten)
Else
Set wkbOld = ActiveWorkbook                                                          _
'diese Datei merken
rDatei.Resize(lAnzDatei, 1).EntireRow.Copy                                           _
'gesamte Zeile kopieren
Workbooks.Add                                                                        _
'neues Excelsheet
Set wkbNew = ActiveWorkbook                                                          _
'Focus liegt automatisch auf neuer Datei! Darum klappt "activeworkbook" nochmal
wkbNew.Sheet1.Range("A1").Resize(lAnzDatei, 1).EntireRow.PasteSpecial                _
'einfügen
wkbNew.SaveAs Filename:=sPath & "\" & rDatei.Value & ".xls", FileFormat:=xlExcel8    _
'neue Datei speichern als *.xls
wkbNew.Close                                                                         _
'neue Datei schließen
rDatei.Resize(lAnzDatei, 1).EntireRow.ClearContents                                  _
'Datensatz aus alter Datei entfernen
End If
Next rDatei
End With

Anzeige
AW: Zeilen markieren wenn bestimmter Wert enthalten
05.12.2012 15:56:50
Jan
Hallo Klaus,
das ist große Klasse! Danke dir!!
Leider wird nur bei mir ein Laufzeitfehler 438 generiert:
Objekt unterstützt diese Eigenschaft oder Methode nicht.
und zwar geht es um diese Zeile:
wkbNew.Sheet1.Range("A1").Resize(lAnzDatei, 1).EntireRow.PasteSpecial _
Und wie meinst du das
"Hier die SPALTE angeben in der die nächsten Dateinamen stehen! A = 1, B = 2"
Gibt man das manuell bei jedem Durchlauf ein?
Ansonsten schaue ich mir das gleich mal alles an, um zu verstehen, was dort abgeht... ;)
Schöne Grüße
Jan

AW: Zeilen markieren wenn bestimmter Wert enthalten
06.12.2012 08:26:22
Klaus
Hi,
die Zeile
wkbNew.Sheet1.Range("A1").Resize(lAnzDatei, 1).EntireRow.PasteSpecial
läuft bei mir artig durch, teste ich aber gleich nochmal. Bei mir läuft WinXP Professional mit Office 2010, bei dir läuft sicher auch 2010?
Ne, das mit der Spalte musst du gar nicht ändern - wenns Spalte A (=1) ist. Es ist nur so, dass sehr oft Leute mit geringem VBA-Kentnissstand hier posten und dann heisst es: "Im Beispiel geht es um Spalte A".
Dann schreibt man einen Code in dem gefühlte 200mal die Spalte A hart referenziert wird. In der Antwort heisst es dann: "Oh, aber in meiner Originaldatei ist es dann Spalte BCA ..."
Darum hab ich mir angewöhnt, variable Spalten und Zeilen am Anfang des Codes einmal zu referenzieren. Schau dir den Code mal in Ruhe an, überall wo du "Spalte A" erwartest steht stattdessen "Spalte iCol". Wenn du den Code jetzt für eine Datei brauchst, wo die Sachen in Spalte F stehen, änderst du oben nur einmal in iCol = 5 und das wars.
Grüße,
Klaus M.vdT.

Anzeige
OK, ging wirklich nicht ....
06.12.2012 08:35:42
Klaus
... seltsam, als ichs gestern getestet habe lief es noch!
Naja, etwas umgestrickt. Sollte jetzt laufen.
Anmerkung: die vielen _ am Zeilenende des letzten Codes hat der Herber-Codevorschau-Zeilenumbruch-Script verursacht, die sind für den Code nicht notwendig.
Option Explicit
Sub SaveManyFiles()
Dim iCol As Integer
Dim wksOld As Worksheet
Dim sPath As String
'Umbenennen! Wird bei dir ja nicht "Tabelle1" heissen
Set wksOld = Sheets("Tabelle1")
'Hier die SPALTE angeben in der die nächsten Dateinamen stehen! A = 1, B = 2
iCol = 1
'Hier werden die neuen Dateien gespeichert
sPath = "C:\TestTMP"
'Hier fängt der Code an!
Dim rDatei As Range
Dim lRowLast As Long
Dim lAnzDatei As Long
Dim wkbOld As Workbook
Dim wkbNew As Workbook
Dim iColLast As Integer
With wksOld
lRowLast = .Cells(Rows.Count, iCol).End(xlUp).Row
'letzte Zeile
iColLast = .UsedRange.Columns.Count
'Anzahl Spalten
For Each rDatei In Range(Cells(2, iCol), Cells(lRowLast, iCol))
'für den Bereich
lAnzDatei = Application.WorksheetFunction.CountIf(.Cells(1, iCol).EntireColumn,  _
rDatei.Value)   'so viele Datensätze dieses Names gibt es
If rDatei = "" Then _
'wenn leer dann nix! (Leer wenn gelöscht, siehe unten)
Else
Set wkbOld = ActiveWorkbook
'diese Datei merken
rDatei.Resize(lAnzDatei, iColLast).Copy
'gesamte Zeile kopieren
Workbooks.Add
'neues Excelsheet
Set wkbNew = ActiveWorkbook
'Focus liegt automatisch auf neuer Datei! Darum klappt "activeworkbook" nochmal
Range("A1").PasteSpecial
'einfügen
wkbNew.SaveAs Filename:=sPath & "\" & rDatei.Value & ".xls", FileFormat:=xlExcel8
'neue Datei speichern als *.xls
wkbNew.Close
'neue Datei schließen
rDatei.Resize(lAnzDatei, 1).EntireRow.ClearContents
'Datensatz aus alter Datei entfernen
End If
Next rDatei
End With
End Sub

Anzeige
AW: OK, ging wirklich nicht ....
06.12.2012 11:12:18
Jan
das ist ja so geil!!
funktioniert, auch mit Spalte B ;)
Bevor mein VBA-Buch eintrifft, gibst du mir noch einen "Hinweis" bitte?
Wie funktioniert es am Besten, wenn ich innerhalb der jeweils neu erstellten Tabelle Spalte B auf unterschiedliche Reiter verteile (in dem Fall würden also die Reiter EFGH_1, EFGH_2 und EFGH_3 mit dem jeweiligen Zeileninhalt erstellt werden und ich würde anschließend Tabelle1, Tabelle2, Tabelle3 löschen...)?
Spalte 1 - Spalte 2
ABCD_1 - EFGH_1
ABCD_1 - EFGH_1
ABCD_1 - EFGH_2
ABCD_1 - EFGH_2
ABCD_1 - EFGH_3
Um innerhalb der Reiter dann jeweils zu formatieren, kann ich wahrscheinlich an der entsprechenden Stelle einfach meinen aufgezeichneten Makro-Code reinkopieren, oder?
Muchas Gracis :)

Anzeige
auf Blätter verteilen
06.12.2012 11:27:46
Klaus
Hi,
das würde ich als Teilproblem betrachten. Also: Ein Makro schreiben, dass aus Spalte B die neuen Tabellenblätter ausliest, diese erstellt und den benötigen Inhalt dahin kopiert.
das Makro dann innerhalb des ersten Makros aufrufen, nachdem das neue Blatt erstellt wurde.
Glück für dich langweile ich mich gerade :-)
Ich setzt mich da mal ran und bastel was.
(Aber das nächste mal schreibst du sowas gleich mit in den Anfangsbeitrag!)
Grüße,
Klaus M.vdT.

AW: auf Blätter verteilen
06.12.2012 11:37:20
Jan
Hallo Klaus,
tue ich nächstes Mal natürlich, wobei ich hoffe, dann selbst so fit zu sein.
btw. Kannst du ein gutes Einsteigerbuch für Visual Basic und Makro-Programmierung empfehlen?
Danke noch mal, führe gerade noch das erste Makro aus - läuft nämlich über 40.000 Datensätze ;)

Anzeige
mein anderer Beitrag:
06.12.2012 12:06:49
Klaus
Hi,
Tja, da wirst du alles löschen müssen und dann mein "neues" Makro laufen lassen, dass die Dateien erstellt und in den Dateien auch die verlangten "Tables" erstellt .. ich drösel das jetzt nicht wieder ausseinander.
Ein gutes Buch über VBA kann ich dir eindeutig NICHT empfehlen. Mein Problem mit Buchwissen ist immer: ich hab ein Lehrbuchbeispiel, und eine Lehrbuchlösung - nur keine Lösung für MEIN Problem, und auch keine Motivation an einer Lösung rumzubasteln denn es ist ja nur fürs Buch.
Ich habe mir (wie wohl die meisten hier im Forum) das gesamte VBA autodidaktisch beigebracht, indem ich immer wieder kleine Fragen hier im Forum gestellt habe - und die antworten nicht blind kopiert, sondern immer zu verstehen versucht habe.
Allerdings habe ich meinerzeit (anfang der 90er ... lange her) gelernt, GW-Basic und Q-Basic unter DOS zu programmieren. Das hilft mir natürlich bei VBA.
Dann gibts da noch die Nachteile des autodidaktischen lernens: ein paar Grundlagen fehlen immer. Grad bin ich über "intersect" gestolpert - ein allerweltsbefehl aus dem VBA Grundkurs. Kannte ich nicht.
Oder Variablendeklaration. Hab ich erst ganz spät mit angefangen.
Unbedingt Lesenswert finde ich die Beschreibungen von Peter Haserodt, die du hier findest.
http://www.online-excel.de/excel/grusel_vba.php?f=6
Grüße und viel Erfolg beim lernen!
Klaus M.vdT.

Anzeige
AW: OK, ging wirklich nicht ....
06.12.2012 11:59:10
Klaus
Hi,
probier mal den.
Anmerkung: Das Ursprungsblatt muss sortiert sein!
also zum Beispiel das:
ABCD_1 - EFGH_1
ABCD_1 - EFGH_1
ABCD_1 - EFGH_2
ABCD_1 - EFGH_2
ABCD_1 - EFGH_1 (GAB SCHONMAL WEITER OBEN)
darf nicht passieren, sonst gibts nen Error!
Anmerkung zwei:
im Zweifelsfall funktioniert das:
Sheets("Tabelle1").Delete
Sheets("Tabelle2").Delete
Sheets("Tabelle3").Delete
nicht wie es soll. Ich hab englisches Exel, bei mir muss es heissen Sheets("Sheet1").delete Ich bin mir ziemlich, aber nicht 100% ig, sicher dass es im deutschen Excel "Tabelle1" heisst. Ausserdem weiss ich ja nicht, ob du überhaupt ein deutsches Excel hast :-)
Anmerkung 3: (für stille Mitleser, nicht für dich)
ja, ich lösche Datensätze aus einer laufenden Schleife und frage dann den neuen Inhalt auf "" ab. Mit ist bewusst dass das nicht ganz sauber ist und ab ein paar millionen Datensätzen auch zu unnötigen Performanceeinbrüchen führt. Hier solls reichen, und es ist recht einfach zu programmieren und hoffentlich auch einfach nachzuvollziehen. Meiner Meinung nach ist ein nachvollziehbarer Code eine bessere Hilfe als ein bis-ins-letzte optimierter Ablauf, den der Neuling gar nicht verstehen kann - und ja, ich war zu faul das optimal zu schreiben :-)
Grüße,
Klaus M.vdT.
Option Explicit
Sub SaveManyFiles()
Dim icol As Integer
Dim iColTable As Integer
Dim wksOld As Worksheet
Dim sPath As String
'Umbenennen! Wird bei dir ja nicht "Tabelle1" heissen
Set wksOld = Sheets("Tabelle1")
'Hier die SPALTE angeben in der die nächsten Dateinamen stehen! A = 1, B = 2
icol = 1
'und hier die SPALTE, in der die Tabellennamen stehen!
iColTable = 2
'Hier werden die neuen Dateien gespeichert
sPath = "C:\TestTMP"
'Hier fängt der Code an!
Dim rDatei As Range
Dim lRowLast As Long
Dim lAnzDatei As Long
Dim wkbOld As Workbook
Dim wkbNew As Workbook
Dim iColLast As Integer
With wksOld
lRowLast = .Cells(Rows.Count, icol).End(xlUp).Row
'letzte Zeile
iColLast = .UsedRange.Columns.Count
'Anzahl Spalten
For Each rDatei In Range(Cells(2, icol), Cells(lRowLast, icol))
'für den Bereich
lAnzDatei = Application.WorksheetFunction.CountIf(.Cells(1, icol).EntireColumn, _
rDatei.Value)   'so viele Datensätze dieses Names gibt es
If rDatei = "" Then _
'wenn leer dann nix! (Leer wenn gelöscht, siehe unten)
Else
Set wkbOld = ActiveWorkbook
'diese Datei merken
rDatei.Resize(lAnzDatei, iColLast).Copy
'gesamte Zeile kopieren
Workbooks.Add
'neues Excelsheet
Set wkbNew = ActiveWorkbook
'Focus liegt automatisch auf neuer Datei! Darum klappt "activeworkbook" nochmal
Range("A1").PasteSpecial
'einfügen
Call MakeManyTables(iColTable)
'hier wird das Makro aufgerufen, dass die Unteraufgabe erfüllt
wkbNew.SaveAs Filename:=sPath & "\" & rDatei.Value & ".xls", FileFormat:= _
xlExcel8
'neue Datei speichern als *.xls
wkbNew.Close
'neue Datei schließen
rDatei.Resize(lAnzDatei, 1).EntireRow.ClearContents
'Datensatz aus alter Datei entfernen
End If
Next rDatei
End With
End Sub
Sub MakeManyTables(iColNew As Integer)
Dim lRow As Long
Dim lAnzTable As Long
Dim wksOld As Worksheet
Set wksOld = ActiveSheet    'Blatt merken
Dim rTables As Range
lRow = Cells(Rows.Count, iColNew).End(xlUp).Row 'letzte Zeile
For Each rTables In Range(Cells(1, iColNew), Cells(lRow, iColNew))
If rTables.Value = "" Then
'nix! wenn leer dann nix!
Else    'aber sonst!
lAnzTable = Application.WorksheetFunction.CountIf(Cells(1, iColNew).EntireColumn,  _
rTables.Value)
'so viele Datensätze dieses Names gibt es
Cells(rTables.Row, 1).Resize(lAnzTable, Columns.Count).Copy 'kopieren
Sheets.Add          'neues sheet
With ActiveSheet    'das neu erstellte sheet ist automatisch "active"!
.Name = rTables.Value 'sheet umbenennen
.Range("A2").PasteSpecial
.Range("A1").Value = "Überschrift 1"    'Überschriften wirst du brauchen?
.Range("B1").Value = "Überschrift 2"    'ändere sie hier!
.Range("C1").Value = "Überschrift 3"    'wenns mehr als vier Spalten werden,
.Range("D1").Value = "Überschrift 4"    'einfach fortsetzen bis der Artzt kommt. _
End With
wksOld.Activate 'zurück zum alten Blatt
Cells(rTables.Row, 1).Resize(lAnzTable, Columns.Count).ClearContents 'alten  _
Datensatz löschen
End If
Next rTables
'* Dieser Block löscht die nun nicht mehr benötigten Tabellen 1, 2 und 3.
'* Das "DisplayAlerts" wird abgeschaltet, um das Fenster vom Excel
'* "da kann aber was in der Tabelle sein! Echt löschen?" zu verhindern
Application.DisplayAlerts = False
Sheets("Tabelle1").Delete
Sheets("Tabelle2").Delete
Sheets("Tabelle3").Delete
Application.DisplayAlerts = True
'* Block Tabellenlöschen Ende
End Sub

Anzeige
noch eine Kleinigkeit:
06.12.2012 12:41:08
Klaus
Mit:
Sheets("Tabelle1").Delete
Sheets("Tabelle2").Delete
Sheets("Tabelle3").Delete

gehe ich natürlich blind davon aus, dass dein Excel in den Standardeinstellungen ("neues Blatt mit drei Tabellen") läuft.
Wenn man es jetzt 100%ig richtig machen will, müsste man nach dem Makro zum Tabellen-Erstellen die gesamt vorhandenen Tabellen zählen, und eben die überzähligen ausrechen und löschen. Tut für deine Zwecke aber nicht not, oder?
Grüße,
Klaus M.vdT.

AW: OK, ging wirklich nicht ....
06.12.2012 12:43:16
Jan
Wunderbaaaar!! =)
Jetzt muss das Makro nur noch dafür sorgen, dass beim Tabellennamen nur die ersten 30 Zeichen genommen werden bzw. nur die Zeichen bis zum ersten Mal eine Leerzeile auftaucht.
Da recherchiere ich mal.
Vielen Dank für Deine Hilfe!
(und wenn ich deine Adresse hätte, würde ich dir ja etwas Kleines zukommen lassen)

Anzeige
Danke für die Rückmeldung! mit Text
06.12.2012 12:54:47
Klaus
Hallo Jan,
danke für die positive Rückmeldung!
das mit den "ersten 30 Zeichen oder bis zum Leerzeichen" ist nicht sooo schwer, das lasse ich dich mal selbst recherchieren und rausfinden.
(und wenn ich deine Adresse hätte, würde ich dir ja etwas Kleines zukommen lassen)
Meine Adresse bekommst du aber nicht ;-) Aber danke für die Geste.
Deal: lerne weiter Excel und VBA, und irgendwann hilfst du jemand anderem in diesem Forum (oder im echten Leben...) mit deinem Wissen weiter, dann sind wir quitt!
Grüße,
Klaus M.vdT.

AW: Danke für die Rückmeldung! mit Text
07.12.2012 12:09:35
Jan
Hallo Klaus,
danke für Deine Hilfe!! (das mit der Standardeinstellung 3 Tabellen stimmt, das passt alles). Ja, ich arbeite gerade an einem schönen Makro und es wird jemandem richtig helfen, und natürlich werde ich das Wissen dann auch weitergeben. =)
Und jetzt begebe ich mich jetzt mal auf die Suche nach dem 30-Zeilen-Code =)
Schönes Wochenende!
Jan
Anzeige

170 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige