Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Excel
  Zahlenreihe suchen und Zeile löschen per VBA

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:  Zahlenreihe suchen und Zeile löschen per VBA (4248 mal gelesen)
CADdoctor
Mitglied
Technischer Zeichner (Versorgungstechnik)


Sehen Sie sich das Profil von CADdoctor an!   Senden Sie eine Private Message an CADdoctor  Schreiben Sie einen Gästebucheintrag für CADdoctor

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Sehen Sie sich das Profil von RSchulz an!   Senden Sie eine Private Message an RSchulz  Schreiben Sie einen Gästebucheintrag für RSchulz

Beiträge: 5541
Registriert: 12.04.2007

erstellt am: 06. Dez. 2010 17:16    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für CADdoctor 10 Unities + Antwort hilfreich

Hallo,
erstens überschreibst du die Variable "Zahlen" immer wieder und so gewinnt das letzte Feld der Reihe. Zweitens fehlt die ein Trennzeichen, was hinzugefügt werden sollt. Drittens solltest du mit Instr suchen ob eine Zahlenkombination vorkommt. Wie sieht denn die Tabelle aus bzw. wo holt er sich die Kombination wie her... 

------------------
MFG
Rick Schulz
      Nettiquette (CAD.de)  -  Was ist die Systeminfo?  -  Wie man Fragen richtig stellt.  -  Unities

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

CADdoctor
Mitglied
Technischer Zeichner (Versorgungstechnik)


Sehen Sie sich das Profil von CADdoctor an!   Senden Sie eine Private Message an CADdoctor  Schreiben Sie einen Gästebucheintrag für CADdoctor

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


Zahlenreihen.xls.txt

 
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



Sehen Sie sich das Profil von RSchulz an!   Senden Sie eine Private Message an RSchulz  Schreiben Sie einen Gästebucheintrag für RSchulz

Beiträge: 5541
Registriert: 12.04.2007

erstellt am: 06. Dez. 2010 20:30    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für CADdoctor 10 Unities + Antwort hilfreich

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)


Sehen Sie sich das Profil von Beverly an!   Senden Sie eine Private Message an Berverly  Schreiben Sie einen Gästebucheintrag für Berverly

Beiträge: 394
Registriert: 11.08.2007

erstellt am: 07. Dez. 2010 09:51    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für CADdoctor 10 Unities + Antwort hilfreich

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)


Sehen Sie sich das Profil von CADdoctor an!   Senden Sie eine Private Message an CADdoctor  Schreiben Sie einen Gästebucheintrag für CADdoctor

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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)


Sehen Sie sich das Profil von Beverly an!   Senden Sie eine Private Message an Berverly  Schreiben Sie einen Gästebucheintrag für Berverly

Beiträge: 394
Registriert: 11.08.2007

erstellt am: 07. Dez. 2010 10:31    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für CADdoctor 10 Unities + Antwort hilfreich

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 >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz