Autor
|
Thema: Zeilen mit bestimmter Zellenfarbe suchen und ganze Zeile löschen (12811 mal gelesen)
|
CADdoctor Mitglied Technischer Zeichner (Versorgungstechnik)
Beiträge: 313 Registriert: 12.05.2007 Software: AutoCAD MEP 2013 Excellink 2013 Windows 7 x64 Pro SP 1 Office 2010 SP 1 Mozilla Firefox 13.0.1 Mozilla Thunderbird 13.0.1<P>Hardware: ASUS P6T WS Professional Intel Core i7-920, 4x 2.67GHz PNY Quadro FX 1800 Kingston HyperX DIMM XMP Kit 6GB Kingston HyperX SSD 120GB, SATA 6Gb/s
|
erstellt am: 10. Okt. 2010 21:59 <-- editieren / zitieren --> Unities abgeben:
Hallo! Ich möchte in meiner Gesamten Arbeitsmappe nach bestimmten Zellenhintergrundfarben suchen und dann die ganze Zeile löschen. z.B.: Wenn A1=gelb und A2=gelb und A3=gelb und A4=grün und A5=grün und A6=blau dann Zeile löschen Ich habe mal mit VBA experimentiert: Sub ZeilenLöschen() lZeile = Cells(Rows.Count, 1).SpecialCells(xlLastCell).Row For i = lZeile To 1 Step -1 If Cells(i, 1).Interior.ColorIndex = 6 And Cells(i, 2).Interior.ColorIndex = 6 And Cells(i, 3).Interior.ColorIndex = 6 And Cells(i, 4).Interior.ColorIndex = 4 And Cells(i, 5).Interior.ColorIndex = 4 And Cells(i, 6).Interior.ColorIndex = 5 Then Rows(i).Delete End If Next i End Sub Was mache Ich falsch? ------------------ Mit freundlichen Grüßen CADdoctor Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
MarkusK Mitglied
Beiträge: 130 Registriert: 09.08.2002
|
erstellt am: 10. Okt. 2010 22:28 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Hallo CADdoctor, liegt daran, dass grün nicht 4 sondern 10 entspricht. Zumindest bei mir, und eines von mehreren grün. Die Farben kann man in den Optionen auch noch anpassen. Das heißt es könnte vorkommen, dass auf Platz 10 nicht unbedingt grün liegt. (ist aber wohl eher unwarscheinlich dass das einer ändert) Schau dir beim durchlauf einfach mal die ColorIndexe der entsprechenden Zeilen an. ------------------ Gruss Markus Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Paulchen Mitglied Bauing./SW-Entwickler
Beiträge: 1227 Registriert: 19.08.2004 Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice
|
erstellt am: 11. Okt. 2010 09:25 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Guten Morgen, ich habe die Aufgabenstellung nicht verstanden . Zitat: Wenn A1=gelb und A2=gelb und A3=gelb und A4=grün und A5=grün und A6=blau dann Zeile löschen
A1 bis A6: Das sind sechs Zeilen; nach meinem Verständnis ist 6 <> 1. Welche Zeile(n) sollen gelöscht werden - alle 6? Wie erhalten die Zellen ihre Farben - am Ende gar über bedingte Formatierung aus Deinem Nachbarbeitrag? Dann ist es sicherer und eleganter, die Bedingung (und nicht die Farbe) zu prüfen. Woher weißt Du, das Du was "falsch" machst - was genau klappt denn nicht, wie erhofft? Für "saubereren" Code hilft es, in VBA unter Extras - Optionen, Reiter Editor unter Variablendeklaration erforderlich ein Häkchen zu setzen. Das schreibt dann Option Explicit zu Beginn des Moduls und erzwingt, dass alle Variablen benannt sein müssen. Zum (vermuteten) Problem: Geh' mal Deine Routine im Einzelschritt mit Taste F8 durch und beobachte i. Beim ersten Durchlauf hat i z. B. den Wert 10. Du überprüfst nun, ob Zelle (10, 1) - also A10 - und dann ob Zelle (10, 2) - also B10 - usw. Farben enthält. Cells(Rowindex, Columnindex) --> vertausche mal i und die Zahl in Cells(). ------------------ DIN1055.de | Lastannahmen für Anwender NEU: Foren zu DIN 1055 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADdoctor Mitglied Technischer Zeichner (Versorgungstechnik)
Beiträge: 313 Registriert: 12.05.2007 Software: AutoCAD MEP 2013 Excellink 2013 Windows 7 x64 Pro SP 1 Office 2010 SP 1 Mozilla Firefox 13.0.1 Mozilla Thunderbird 13.0.1<P>Hardware: ASUS P6T WS Professional Intel Core i7-920, 4x 2.67GHz PNY Quadro FX 1800 Kingston HyperX DIMM XMP Kit 6GB Kingston HyperX SSD 120GB, SATA 6Gb/s
|
erstellt am: 11. Okt. 2010 09:58 <-- editieren / zitieren --> Unities abgeben:
Guten Morgen Paulchen! Es muss natürlich nicht A1 bis A6 heißen sondern A1 bis F1! Tschuldigung ! Die Zellen haben ihre Hintergrundfarbe nicht über eine bedingte Formatierung erhalten. (also hat nicht mit meinem anderen Beitrag zu tun.) Ich hab den Fehler schon gefunden. Das grün mit dem Ich meinen Hintergrund gefärbt hatte, entspricht nicht der Indexfarbe 4! Hab alles auf die Farbe 4 geändert und jetzt funktionierts. Ich hänge momentan bei dem Versuch mehrere Fälle in mein VBA Prog einzubauen. Und das ganze soll natürlich in allen Tabellenblättern gemacht werden. Sub Farbenlöschen() Dim g as Integer Dim i as double For i = 1 To ActiveWorkbook.WorkSheets.Count For Each RaZelle In ActiveWorkbook.worksheets(i).UsedRange With RaZelle Select Case .Value Case 1 = Cells(g, 1).Interior.ColorIndex = 6 And Cells(g, 2).Interior.ColorIndex = 6 And Cells(g, 3).Interior.ColorIndex = 6 And Cells(g, 4).Interior.ColorIndex = 4 And Cells(g, 5).Interior.ColorIndex = 26 And Cells(g, 6).Interior.ColorIndex = 5 Then Rows(g).Delete Case 2 = Cells(g, 1).Interior.ColorIndex = 6 And Cells(g, 2).Interior.ColorIndex = 6 And Cells(g, 3).Interior.ColorIndex = 4 And Cells(g, 4).Interior.ColorIndex = 4 And Cells(g, 5).Interior.ColorIndex = 5 And Cells(g, 6).Interior.ColorIndex = 5 Then Rows(g).Delete End Select End With Next RaZelle Next i End Sub Das Ganze funktioniert aber leider noch nicht fehlerfrei!
------------------ Mit freundlichen Grüßen CADdoctor Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Paulchen Mitglied Bauing./SW-Entwickler
Beiträge: 1227 Registriert: 19.08.2004 Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice
|
erstellt am: 11. Okt. 2010 11:46 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Aha, die Schatten lichten sich ! Select Case mit .Value prüft den Zellwert, nicht die Farbe. Select Case und Case 1 = ... Then wird nicht funktionieren. Guck' in die Hilfe zu Select Case, die F1-Taste ist Dein Freund, wenn Du den Cursor in Select Case positioniert hast. Was hast Du denn vor? Unterschiedliche Farbkombinationen löschen? Dann würde ich - nur als Vorschlag - ein paar weitere Variablen einführen, als Boolean, die kennen nur WAHR oder FALSCH. Klingt zunächst wild, steigert aber letztlich die Übersicht und Erweiterbarkeit. Nennen wir sie "Bedingungen", als Boolean, und es können mehrere werden. Also bolBed01, bolBed02 usw. Nimm' diesen Ansatz, teste bitte selbst. Code: Sub ZeileLoeschenWennFarbe()Dim ilZeile As Integer 'letzte Zeile Dim i As Integer Dim bolBed1 As Boolean 'WAHR, falls die erste Bedingung erfüllt wird; Default: False Dim bolBed2 As Boolean ilZeile = Cells(Rows.Count, 1).SpecialCells(xlLastCell).Row For i = ilZeile To 1 Step -1 'ERSTE Bedingung festlegen, reines if-then. Am Zeilenende " _[Enter] für mehr Übersicht If Cells(i, 1).Interior.ColorIndex = 6 _ And Cells(i, 2).Interior.ColorIndex = 6 _ And Cells(i, 3).Interior.ColorIndex = 6 _ And Cells(i, 4).Interior.ColorIndex = 4 _ And Cells(i, 5).Interior.ColorIndex = 26 _ And Cells(i, 6).Interior.ColorIndex = 5 Then bolBed1 = True 'ZWEITE Bedingung festlegen If Cells(i, 1).Interior.ColorIndex = 6 _ And Cells(i, 2).Interior.ColorIndex = 6 _ And Cells(i, 3).Interior.ColorIndex = 4 _ And Cells(i, 4).Interior.ColorIndex = 4 _ And Cells(i, 5).Interior.ColorIndex = 26 _ And Cells(i, 6).Interior.ColorIndex = 5 Then bolBed2 = True '... weitere Bedingungen 'eigentlicher Löschvorgang If bolBed1 = True Or bolBed2 = True Then Rows(i).Delete bolBed1 = False 'zurücksetzen bolBed2 = False End If Next i End Sub
BTW: Farbenlöschen ist KEIN guter Name, da das "ö" ein Sonderzeichen darstellt. Mach' ein "oe" daraus, und gut.[Edit: Noch eleganter wird es, wenn Du eine eigene Function baust, die den Boolean steuert. Als Übergabeparameter werden die Farbnummern verwendet... /Edit] [Diese Nachricht wurde von Paulchen am 11. Okt. 2010 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Paulchen Mitglied Bauing./SW-Entwickler
Beiträge: 1227 Registriert: 19.08.2004 Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice
|
erstellt am: 11. Okt. 2010 12:03 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
... also etwa so: Code: Private Sub ZeileWegErweitert()Dim ilZeile As Integer 'letzte Zeile Dim i As Integer ilZeile = Cells(Rows.Count, 1).SpecialCells(xlLastCell).Row For i = ilZeile To 1 Step -1 'ausgelagert: Diese Farben prüfen... If LoeschbedingungFarben(i, 6, 6, 6, 4, 26, 5) = True Or _ LoeschbedingungFarben(i, 6, 6, 6, 4, 5, 5) = True Then 'eigentlicher Löschvorgang Rows(i).Delete End If Next i End Sub Private Function LoeschbedingungFarben(i As Integer, ic1 As Integer, ic2 As Integer, ic3 As Integer, _ ic4 As Integer, ic5 As Integer, ic6 As Integer) As Boolean 'prüft Farbkombination mittels UND; liefert TRUE, falls erfüllt 'ic# = "IntegerColor" als Parameter If Cells(i, 1).Interior.ColorIndex = ic1 _ And Cells(i, 2).Interior.ColorIndex = ic2 _ And Cells(i, 3).Interior.ColorIndex = ic3 _ And Cells(i, 4).Interior.ColorIndex = ic4 _ And Cells(i, 5).Interior.ColorIndex = ic5 _ And Cells(i, 6).Interior.ColorIndex = ic6 Then LoeschbedingungFarben = True End Function
------------------ DIN1055.de | Lastannahmen für Anwender NEU: Foren zu DIN 1055 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Beverly Mitglied Dipl.-Geologe (Rentner)
Beiträge: 394 Registriert: 11.08.2007
|
erstellt am: 11. Okt. 2010 15:29 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Hi, ungetestet:
Code: Sub Farbenlöschen() Dim lngZeile As Long Dim wshTabelle As Worksheet For Each wshTabelle In ActiveWorkbook.Worksheets With wshTabelle For lngZeile = .UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1 If Cells(lngZeile, 1).Interior.ColorIndex = 6 And Cells(lngZeile, 2).Interior.ColorIndex = 6 And _ Cells(lngZeile, 3).Interior.ColorIndex = 6 And Cells(lngZeile, 4).Interior.ColorIndex = 4 And _ Cells(lngZeile, 5).Interior.ColorIndex = 26 And Cells(lngZeile, 6).Interior.ColorIndex = 5 Then Rows(lngZeile).Delete ElseIf Cells(lngZeile, 1).Interior.ColorIndex = 6 And Cells(lngZeile, 2).Interior.ColorIndex = 6 And _ Cells(lngZeile, 3).Interior.ColorIndex = 4 And Cells(lngZeile, 4).Interior.ColorIndex = 4 And _ Cells(lngZeile, 5).Interior.ColorIndex = 5 And Cells(lngZeile, 6).Interior.ColorIndex = 5 Then Rows(lngZeile).Delete End If Next lngZeile End With Next wshTabelle End Sub
------------------ Bis später, Karin [Diese Nachricht wurde von Beverly am 11. Okt. 2010 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADdoctor Mitglied Technischer Zeichner (Versorgungstechnik)
Beiträge: 313 Registriert: 12.05.2007 Software: AutoCAD MEP 2013 Excellink 2013 Windows 7 x64 Pro SP 1 Office 2010 SP 1 Mozilla Firefox 13.0.1 Mozilla Thunderbird 13.0.1<P>Hardware: ASUS P6T WS Professional Intel Core i7-920, 4x 2.67GHz PNY Quadro FX 1800 Kingston HyperX DIMM XMP Kit 6GB Kingston HyperX SSD 120GB, SATA 6Gb/s
|
erstellt am: 13. Okt. 2010 13:51 <-- editieren / zitieren --> Unities abgeben:
Danke für eure Codes Paulchen und Beverly! Paulchen zweite Variante hab Ich schon getestet läuft im kleinen sehr (10 gleiche Farbkombis) gut! Doch wenn Ich mehrerre Farbkombis (56 gleiche Farbkombis) in meinem Tabellenblatt habe, bekomme Ich einen Laufzeitfehler 6 Überlauf. Also hab Ich alle Integer durch Long ersetzt und jetzt dauert der ganze Durchlauf eine Ewigkeit! Gibts da eine Alternative die weniger lange dauert? Beverlys Code hab Ich leider noch nicht testen können!
------------------ Mit freundlichen Grüßen CADdoctor Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Paulchen Mitglied Bauing./SW-Entwickler
Beiträge: 1227 Registriert: 19.08.2004 Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice
|
erstellt am: 13. Okt. 2010 14:56 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Hm... ein Long benötigt auf alle Fälle mehr Speicherplatz als ein Integer; überleg' Dir, ob es wirklich Long sein müssen. Aus der Hilfe zu VBA: Variablen vom Datentyp Integer werden als 16-Bit-Zahlen (2 Bytes) in einem Bereich von -32.768 bis 32.767 gespeichert. Variablen vom Datentyp Long (lange Ganzzahl) werden als 32-Bit-Zahlen (4 Bytes) mit Vorzeichen im Bereich von -2.147.483.648 bis 2.147.483.647 gespeichert. Vielleicht magst Du eine Dummy-Mappe (ohne sensible Daten) mit enthaltenen Farbkombinationen als .zip hier hochladen? Fürs Nachbauen bin ich gerade zu faul. Was meinst Du mit "56 gleiche Farbkombis" - sind das dann 56 gleiche Zeilen? Alternativ wäre denkbar, alle Treffer (also Zeilennummern) in einem Array abzulegen und dann in einem zweiten Schritt sämtliche Zeilen auf einmal zu löschen..? Das könnte die Geschwindigkeit steigern. ------------------ DIN1055.de | Lastannahmen für Anwender NEU: Foren zu DIN 1055 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADdoctor Mitglied Technischer Zeichner (Versorgungstechnik)
Beiträge: 313 Registriert: 12.05.2007 Software: AutoCAD MEP 2013 Excellink 2013 Windows 7 x64 Pro SP 1 Office 2010 SP 1 Mozilla Firefox 13.0.1 Mozilla Thunderbird 13.0.1<P>Hardware: ASUS P6T WS Professional Intel Core i7-920, 4x 2.67GHz PNY Quadro FX 1800 Kingston HyperX DIMM XMP Kit 6GB Kingston HyperX SSD 120GB, SATA 6Gb/s
|
erstellt am: 13. Okt. 2010 20:41 <-- editieren / zitieren --> Unities abgeben:
|
Nepumuk Mitglied Entwicklungsleiter
Beiträge: 351 Registriert: 16.10.2004
|
erstellt am: 13. Okt. 2010 22:51 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Hallo CADdoctor, etwas unglücklich der Code. 1. In der Hauptroutine prüfst alle 21 Möglichkeiten durch auch wenn schon die erste zutrifft und die anderen garnicht mehr geprüft werden müssen.. 2. In der Unterroutine prüfst du alle 6 Möglichkeiten durch, auch wenn schon die erste nicht zutrifft. 3. Nie jede Zeile einzeln löschen, sondern erst alle Zeilen welche zu löschen sind sammeln und dann alle auf einen Schlag löschen. Code: Option ExplicitPublic Sub ZeileWegErweitert() Dim lngRow As Long Dim blnDeleteRow As Boolean Dim objDeleteRows As Range For lngRow = Cells(Rows.Count, 1).SpecialCells(xlLastCell).Row To 1 Step -1 'ausgelagert: Diese Farben prüfen... If LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 6, 6) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 6, 4) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 6, 26) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 6, 3) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 6, 5) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 4, 4) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 4, 26) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 4, 3) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 4, 5) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 26, 26) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 26, 3) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 26, 5) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 3, 3) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 3, 5) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 6, 5, 5) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 4, 4, 4) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 4, 4, 5) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 6, 6, 6, 4, 5, 5) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 26, 26, 26, 26, 3, 3) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 26, 26, 26, 26, 26, 3) Then blnDeleteRow = True ElseIf LoeschbedingungFarben(lngRow, 26, 26, 26, 26, 26, 26) Then blnDeleteRow = True End If 'sammeln der 1. Zelle der zu löschenden Zeilen If blnDeleteRow Then If objDeleteRows Is Nothing Then Set objDeleteRows = Cells(lngRow, 1) _ Else Set objDeleteRows = Union(objDeleteRows, Cells(lngRow, 1)) blnDeleteRow = False End If Next lngRow 'eigentlicher Löschvorgang If Not objDeleteRows Is Nothing Then objDeleteRows.EntireRow.Delete End Sub Private Function LoeschbedingungFarben(lngRow As Long, ic1 As Long, ic2 As Long, ic3 As Long, _ ic4 As Long, ic5 As Long, ic6 As Long) As Boolean 'prüft Farbkombination mittels UND; liefert TRUE, falls erfüllt 'ic# = "LongColor" als Parameter If Cells(lngRow, 1).Interior.ColorIndex = ic1 Then If Cells(lngRow, 2).Interior.ColorIndex = ic2 Then If Cells(lngRow, 3).Interior.ColorIndex = ic3 Then If Cells(lngRow, 4).Interior.ColorIndex = ic4 Then If Cells(lngRow, 5).Interior.ColorIndex = ic5 Then If Cells(lngRow, 6).Interior.ColorIndex = ic6 Then LoeschbedingungFarben = True End If End If End If End If End If End If End Function
------------------ Gruß Nepumuk Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADdoctor Mitglied Technischer Zeichner (Versorgungstechnik)
Beiträge: 313 Registriert: 12.05.2007 Software: AutoCAD MEP 2013 Excellink 2013 Windows 7 x64 Pro SP 1 Office 2010 SP 1 Mozilla Firefox 13.0.1 Mozilla Thunderbird 13.0.1<P>Hardware: ASUS P6T WS Professional Intel Core i7-920, 4x 2.67GHz PNY Quadro FX 1800 Kingston HyperX DIMM XMP Kit 6GB Kingston HyperX SSD 120GB, SATA 6Gb/s
|
erstellt am: 14. Okt. 2010 11:47 <-- editieren / zitieren --> Unities abgeben:
Mahlzeit Nepumuk! Danke für die Tipps! Der Geschwindigkeitsvorteil von deinem Code ist ja überwältigend. Beim vergleichen habe Ich festgestellt, dass dein Code um ca. 2 Minuten schneller fertig war als meiner. Wo baue Ich am besten eine Schleife für alle Tabellenlätter der Mappe ein? Lt. deinem Beitrag müsste der Code schneller sein, wenn Ich erst in allen Tabellenblätter die zu löschenden Zeilen ermittle und dann löschen. ------------------ Mit freundlichen Grüßen CADdoctor [Diese Nachricht wurde von CADdoctor am 14. Okt. 2010 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Paulchen Mitglied Bauing./SW-Entwickler
Beiträge: 1227 Registriert: 19.08.2004 Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice
|
erstellt am: 14. Okt. 2010 13:23 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Tach auch, Danke an Nepumuk! Sauber ausgebaut. @CADdoctor: Es ist natürlich ein gewaltiger Unterschied, ob wir von 2-3 Zeilen oder - wie in der Beispielmappe - von über 56.000 Zeilen sprechen... Bezüglich Deiner Frage zur Schleife über alle Register hat Beverly oben schon was geschrieben. Wobei ich gedanklich die Arbeit je Register erledigen lassen würde, dann brauchst Du nur einen Array, den Du vor jedem (weiteren) Register einfach leer putzt. Frage: Wie viele Register werden es denn (vermutlich)? Dann könntest Du noch in der Statuszeile (links unten in Excel) eine Meldung ausgeben, die den User auf den Vorgang hinweist, á la Code: Application.StatusBar ="Verarbeite Zeilen..." '... Code... Application.StatusBar = "" Erforderlichenfalls noch die Bildschirmaktualiserung aus- und wieder anschalten (Application.Screenupdating)------------------ DIN1055.de | Lastannahmen für Anwender NEU: Foren zu DIN 1055 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADdoctor Mitglied Technischer Zeichner (Versorgungstechnik)
Beiträge: 313 Registriert: 12.05.2007 Software: AutoCAD MEP 2013 Excellink 2013 Windows 7 x64 Pro SP 1 Office 2010 SP 1 Mozilla Firefox 13.0.1 Mozilla Thunderbird 13.0.1<P>Hardware: ASUS P6T WS Professional Intel Core i7-920, 4x 2.67GHz PNY Quadro FX 1800 Kingston HyperX DIMM XMP Kit 6GB Kingston HyperX SSD 120GB, SATA 6Gb/s
|
erstellt am: 14. Okt. 2010 14:42 <-- editieren / zitieren --> Unities abgeben:
Hallo Paulchen! Ja, das mit den vielen Zeilen hätte Ich dazuschreiben sollen. In meiner Arbeitsmappe sind 234 Tabellenblätter. Bringt mir das Aus- und Einschalten der Bildschirmaktualiserung noch einen zusätzlichen Geschwindigkeitsvorteil oder dient es nur dazu um das Gewackel des Bildes weg zu bekommen? Was bedeutet eigentlich der Unterstrich in der Schleife "If blnDeleteRow" und in der "Private Function" von Nepumuks Code? ------------------ Mit freundlichen Grüßen CADdoctor Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Paulchen Mitglied Bauing./SW-Entwickler
Beiträge: 1227 Registriert: 19.08.2004 Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice
|
erstellt am: 14. Okt. 2010 15:54 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Puh... 234 Blätter x 56.000 Zeilen, das ist 'ne Latte voll! Vorschlag: Anschubsen, Mittagspause . Screenupdating: Primär stellt es das Geflacker ab; wieviel Leistung das zieht, kann ich Dir nicht sagen. Code: Dim objWS As Worksheet Application.ScreenUpdating = False For Each objWS In ThisWorkbook.Worksheets'Blätter durchlaufen Application.StatusBar = "Verarbeite Register " & objWS.Name For lngRow = Cells(Rows.Count, 1).SpecialCells(xlLastCell).Row To 1 Step -1 ... Next lngRow Application.StatusBar = "Verarbeite Blatt " & objws.Name [b]Next objWS Application.StatusBar = "" Application.ScreenUpdating = True
Guck mal in die Statuszeile, nun sollten die Registernamen angezeigt werden. Der Unterstrich steht nach einem Leerzeichen, und danach kommt ein Umbruch - wie oben schonmal im Code erwähnt: Zitat: Am Zeilenende " _[Enter] für mehr Übersicht
Damit "weiß" der Code, dass er eigentlich in einer Zeile steht. Die Zeichenfolge Leerzeichen-Unterstrich-Enter dient nur der Übersicht für den Menschen, da sich der horizontalen Scrollbalken verkürzt.------------------ DIN1055.de | Lastannahmen für Anwender NEU: Foren zu DIN 1055 Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Paulchen Mitglied Bauing./SW-Entwickler
Beiträge: 1227 Registriert: 19.08.2004 Büro: Win10 Enterprise 64bit, Office Professional Plus 2013 - Privat: Linux Mint 15, LibreOffice
|
erstellt am: 14. Okt. 2010 16:25 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
|
carsten-3m Mitglied Dipl.-Ing. Mbau (Produktmanagement, Patent- und Normwesen)
Beiträge: 950 Registriert: 08.05.2007 Excel 2010
|
erstellt am: 14. Okt. 2010 17:44 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Zitat: Original erstellt von Paulchen: Screenupdating: Primär stellt es das Geflacker ab; wieviel Leistung das zieht, kann ich Dir nicht sagen.
Eben flott Beispiel programmiert zum Test. 10000 mal sin(0.5) berechnet und in immer die gleiche Zelle geschrieben dauert auf meiner Mühle 0,547 s ohne Screenupdating 2,137 s mit Screenupdating ------------------ Seit Pro/E Version 1 dabei, auwei... Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
MarkusK Mitglied
Beiträge: 130 Registriert: 09.08.2002
|
erstellt am: 15. Okt. 2010 10:03 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Hallo CADdoctor ich habe letzt auf office-lösungen.de ein interesanten Beitrag zum Löschen gefunden. Wenn du eine leere Spalte übrig hast, ist es schneller diese Hilfsspalte zu füllen, diese zu sortieren, und dann ein Bereich zu löschen. Test mal den Code Code:
Public Sub t() Dim ilZeile As Long 'letzte Zeile Dim i As Long Dim j As Integer Dim Farben As String Dim blnDeleteRow As Boolean Dim LeereSpalte As IntegerApplication.ScreenUpdating = False LeereSpalte = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count ilZeile = Cells(Rows.Count, 1).SpecialCells(xlLastCell).Row For i = ilZeile To 1 Step -1 Farben = "" blnDeleteRow = False For j = 1 To 6 Farben = Farben & Format(Cells(i, j).Interior.ColorIndex, "00") Next j If Farben = "60606060606" Then blnDeleteRow = True ElseIf Farben = "060606060604" Then blnDeleteRow = True ElseIf Farben = "060606060626" Then blnDeleteRow = True ElseIf Farben = "060606060603" Then blnDeleteRow = True ElseIf Farben = "060606060605" Then blnDeleteRow = True ElseIf Farben = "060606060404" Then blnDeleteRow = True ElseIf Farben = "060606060426" Then blnDeleteRow = True ElseIf Farben = "060606060403" Then blnDeleteRow = True ElseIf Farben = "060606060405" Then blnDeleteRow = True ElseIf Farben = "060606062626" Then blnDeleteRow = True ElseIf Farben = "060606062603" Then blnDeleteRow = True ElseIf Farben = "060606062605" Then blnDeleteRow = True ElseIf Farben = "060606060303" Then blnDeleteRow = True ElseIf Farben = "060606060305" Then blnDeleteRow = True ElseIf Farben = "060606060505" Then blnDeleteRow = True ElseIf Farben = "060606040404" Then blnDeleteRow = True ElseIf Farben = "060606040405" Then blnDeleteRow = True ElseIf Farben = "060606040505" Then blnDeleteRow = True ElseIf Farben = "262626260303" Then blnDeleteRow = True ElseIf Farben = "262626262603" Then blnDeleteRow = True ElseIf Farben = "262626262626" Then blnDeleteRow = True End If If blnDeleteRow Then Cells(i, LeereSpalte).Value = True Application.StatusBar = i Next i With ActiveSheet.Columns(LeereSpalte) .EntireRow.Sort .Cells(1), xlAscending, Header:=xlNo On Error Resume Next .SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete On Error GoTo 0 .ClearContents End With End Sub
------------------ Gruss Markus Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADdoctor Mitglied Technischer Zeichner (Versorgungstechnik)
Beiträge: 313 Registriert: 12.05.2007 Software: AutoCAD MEP 2013 Excellink 2013 Windows 7 x64 Pro SP 1 Office 2010 SP 1 Mozilla Firefox 13.0.1 Mozilla Thunderbird 13.0.1<P>Hardware: ASUS P6T WS Professional Intel Core i7-920, 4x 2.67GHz PNY Quadro FX 1800 Kingston HyperX DIMM XMP Kit 6GB Kingston HyperX SSD 120GB, SATA 6Gb/s
|
erstellt am: 17. Okt. 2010 13:27 <-- editieren / zitieren --> Unities abgeben:
|
MarkusK Mitglied
Beiträge: 130 Registriert: 09.08.2002
|
erstellt am: 17. Okt. 2010 17:30 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Hallo CADdoctor, und in welcher Zeile? Bei mir läuft es eigentlich ohne Fehler. Hast du noch irgendwas angepasst oder modifiziert. Leider kann ich bei mir zu Hause die Datei nicht öffnen, da ich nur Office 2000 habe, und ich den Konvertierer (noch) nicht zum laufen gebracht habe Was ich entdeckt habe, ist, dass bei der 1. If-Abfrage in dem String am Anfang eine 0 (Null) fehlt. If Farben = "060606060606" Then Da ich ja für alle 6 Zellen die Farben 2-stellig in ein String schreibe, müssen bei den If-Abragen für Jede Zelle auch immer 2 Ziffern (mit führender Null) angegeben werden.
------------------ Gruss Markus Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CADdoctor Mitglied Technischer Zeichner (Versorgungstechnik)
Beiträge: 313 Registriert: 12.05.2007 Software: AutoCAD MEP 2013 Excellink 2013 Windows 7 x64 Pro SP 1 Office 2010 SP 1 Mozilla Firefox 13.0.1 Mozilla Thunderbird 13.0.1<P>Hardware: ASUS P6T WS Professional Intel Core i7-920, 4x 2.67GHz PNY Quadro FX 1800 Kingston HyperX DIMM XMP Kit 6GB Kingston HyperX SSD 120GB, SATA 6Gb/s
|
erstellt am: 17. Okt. 2010 19:02 <-- editieren / zitieren --> Unities abgeben:
Des Rätsels Lösung: Hab in meiner Test Datei gleich am Anfang 3 leere Zeilen eingefügt. Nach dem löschen der leeren Zeilen, ist auch der Laufzeitfehler '1004' verschwunden. ------------------ Mit freundlichen Grüßen CADdoctor Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|