Autor
|
Thema: Zahlenreihe suchen und Zeile löschen per VBA (4248 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: 06. Dez. 2010 16:52 <-- editieren / zitieren --> Unities abgeben:
Hallo! Ich habe eine Exceldatei mit ca. 100 Registerblättern die Ich nach bestimmten Zahlenkombinationen per VBA durchsuchen möchte. Dazu habe Ich mir ein bestehendes VBA Prog umgeschrieben, das mir alle Zeilen in denen die Zahlenreihen 2,3,4 und 12,13,14 vorkommen löschen soll. Public Sub t() Dim ilZeile As Long 'letzte Zeile Dim i As Long Dim j As Integer Dim Zahlen As String Dim blnDeleteRow As Boolean Dim LeereSpalte As Integer Application.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 Zahlen = "" blnDeleteRow = False For j = 1 To 6 Zahlen = Format(Cells(i, j) Next j If Zahlen = "2,3,4" Then blnDeleteRow = True ElseIf Zahlen = "12,13,14" 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 Leider löscht mir das Prog die Zeilen nicht. Wo liegt da der Hund begraben?
------------------ Mit freundlichen Grüßen CADdoctor Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RSchulz Ehrenmitglied V.I.P. h.c. Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007
|
erstellt am: 06. Dez. 2010 17:16 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
|
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: 06. Dez. 2010 18:25 <-- editieren / zitieren --> Unities abgeben:
Anbei die Tabelle. Die Zahlenreihen sind 2,3,4 und 12,13,14 und kommen in den Spalten A bis F vor. Bsp.: 1|2|3|4|30|58 -> löschen da 2,3,4 vorkommt 1|3|4|5|14|17 -> nicht löschen da nur 3 und 4 vorkommt ------------------ Mit freundlichen Grüßen CADdoctor [Diese Nachricht wurde von CADdoctor am 06. Dez. 2010 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RSchulz Ehrenmitglied V.I.P. h.c. Head of CAD, Content & Collaboration / IT-Manager
Beiträge: 5541 Registriert: 12.04.2007
|
erstellt am: 06. Dez. 2010 20:30 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Guten Abend, der Code ist an für sich nicht wirklich sauber durchdacht. Sry wenn ich das so ausdrücken muss... Dieser hier funktioniert, allerdings muss ich sagen, dass auch dieser noch besser sein könnte. Ich habe allerdings nun keine Lust mehr... Code:
Public Sub t() Dim ilZeile As Long 'letzte Zeile Dim i As Long Dim j As Integer Dim Zahlen As String Dim blnDeleteRow As Boolean Dim LeereSpalte As Integer Dim tmpData() As String Application.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 Zahlen = "" blnDeleteRow = False For j = 1 To 6 Zahlen = Zahlen & ";" & Format(Cells(i, j)) Next j Zahlen = Zahlen & ";" ReDim tmpData(2) tmpData(0) = ";2;" tmpData(1) = ";3;" tmpData(2) = ";4;" blnDeleteRow = check4data(Zahlen, tmpData) If blnDeleteRow = False Then ReDim tmpData(3) tmpData(0) = ";12;" tmpData(1) = ";13;" tmpData(2) = ";14;" tmpData(3) = ";15;" blnDeleteRow = check4data(Zahlen, tmpData) 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 Public Function check4data(ByVal DataRow As String, ByRef tmpCheckdata() As String) As Boolean Dim tmpData As Variant Dim i As Integer For Each tmpData In tmpCheckdata If InStr(DataRow, tmpData) Then i = i + 1 End If Next If i = UBound(tmpCheckdata) + 1 Then check4data = True Else check4data = False End If End Function
Achja und einen kleinen Tipp hätte ich für dich... Probiere erstmal immer nur mit Testdaten. In deinem Fall vll. mit 10 Zeilen. ------------------ MFG Rick Schulz Nettiquette (CAD.de) - Was ist die Systeminfo? - Wie man Fragen richtig stellt. - Unities [Diese Nachricht wurde von RSchulz am 06. Dez. 2010 editiert.] 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: 07. Dez. 2010 09:51 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Hi, versuche es mal so:
Code: Sub Loeschen() Dim lngZeile As Long Dim strKombi As String For lngZeile = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count) To 1 Step -1 strKombi = Cells(lngZeile, 1) & "/" & Cells(lngZeile, 2) & "/" & Cells(lngZeile, 3) & "/" & Cells(lngZeile, 4) & "/" & _ Cells(lngZeile, 5) & "/" & Cells(lngZeile, 6) If InStr(strKombi, "1/2/3") > 0 Or InStr(strKombi, "12/13/14") > 0 Then Rows(lngZeile).Delete Next lngZeile End Sub
Es wird gelöscht, wenn die Zahlenkombinationen 1/2/3 bzw. 12/13/14 an beliebiger Position in der Zeile stehen.------------------ Bis später, Karin 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: 07. Dez. 2010 09:59 <-- editieren / zitieren --> Unities abgeben:
Hallo Karin und Rick! Danke für eure mühe. Ist es auch möglich, alle sechs Spalten von einer vorgegebenen txt oder xls zu hohlen, diese zu vergleichen und dann gegebenenfalls zu löschen. Hab gerade die Aufgab bekommen, verschiedene Positionen in einer mit über 100 Register umfassenden xls zu vergleichen und die Positionen lt. vorgegebener Tabelle zu löschen. ------------------ Mit freundlichen Grüßen CADdoctor 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: 07. Dez. 2010 10:31 <-- editieren / zitieren --> Unities abgeben: Nur für CADdoctor
Hi, ja, das ist möglich. Du musst dann nur eine weitere Schleife außen herum machen, in welcher du die Zeilen der anderen xls- oder txt-Datei durchläufst und jede Zeile mit allen Zeilen der zu prüfenden Datei vergleichst. ------------------ Bis später, Karin Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|