Daten aus Excel Tabelle extrahieren

B

boxleitnerb

Enthusiast
Thread Starter
Mitglied seit
11.01.2007
Beiträge
6.546
Hi!

Ich hab eine Exceltabelle mit vielen Profileinträgen und möchte nur bestimmte Spalten extrahieren bzw. alles Zeilen löschen und nur die behalten, die in der ersten Spalte einen bestimmten Wert haben.

Beispiel:

Profile "Crysis 2"
ShowOn GeForce
ProfileType Application
Executable "crysis2demo.exe"
Executable "crysis2.exe"
Setting ID_0x00a06946 = 0x000240f5
Setting ID_0x1033cec1 = 0x00000003
Setting ID_0x1033cec2 = 0x00000002
Setting ID_0x1033dcd2 = 0x00000004
Setting ID_0x1033dcd3 = 0x00000004
Setting ID_0x1095def8 = 0x02506405
Setting ID_0x10ecdb82 = 0x00000001
EndProfile

Ich möchte ausschließlich die fettgedruckten Zeilen behalten. Der erste Wert (Setting ID 0x00a06946 und 0x1095def8) ist immer gleich für die beiden Zeilen. Und natürlich brauche ich noch die erste Zeile, sonst weiß ich ja nicht, zu welcher Anwendung diese Werte gehören.

Wie stelle ich das am geschicktesten an? Danke schonmal.
 
Wenn Du diese Anzeige nicht sehen willst, registriere Dich und/oder logge Dich ein.
Ist die Konfig, z.B. "Profile", und der Wert, entsprechend "Crysis 2" in Spalte A und B aufgeteilt? Falls ja:

Makro erstelltn mit folgendem Inhalt
Code: 
Option Explicit

Public Sub DelRow()
    Dim Last As Long
    Dim Row As Long
    Application.ScreenUpdating = False
    Last = IIf(IsEmpty(Range("B65536")), Range("B65536").End(xlUp).Row + 1, 65536)
    
      For Row = Last To 1 Step -1
        If Cells(Row, 1) <> "Profile" And Cells(Row, 1) <> "Setting ID_0x00a06946" And Cells(Row, 1) <> "Setting ID_0x1095def8" Then
          Cells(Row, 1).EntireRow.Delete
        End If
      Next
    Application.ScreenUpdating = True
End Sub

Achja: unbedingt Backup erstellen, da strg+z bei Makros nicht so ganz will.
 
Zuletzt bearbeitet:
Thx!

Was muss ich eintragen, damit die Profilzeile dableibt? Also "Profil xyz", sowas in der Richtung.

Edit:
Selbst mit nur
Public Sub DelRow()
Dim Last As Long
Dim Row As Long
Application.ScreenUpdating = False
Last = IIf(IsEmpty(Range("B65536")), Range("B65536").End(xlUp).Row + 1, 65536)

For Row = Last To 1 Step -1
If Cells(Row, 1) <> "Setting ID_0x00a06946" Then
Cells(Row, 1).EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub
Zum Vergrößern anklicken....

löscht er mir restlos alles.

So sieht die Tabelle bei mir aus:


Edit 2:
Das Problem ist das Leerzeichen. Trage ich "EndProfile" ein, passt es und nur die Zeilen bleiben stehen. Aber in den Zeilen, die ich behalten will, stehen auch Leerzeichen drin und die werden ignoriert. Weißt du da ne Lösung?
 
Zuletzt bearbeitet:
Welche Version von Office? Spontan würde mich gar nicht einfallen, wieso der Button nicht funktioniert :O

Normalerweise muss man nur auf Makros klicken, dann Name eingeben und Erstellen - danach öffnet sich VB und man kann dort den Quellcode einfügen. Dann oben auf Ausführen klicken, bzw. F5, und fertig. Ist zumindest hier bei mir im 2007er so.

Achja, noch ein Wort zum Makro:
Das Makro löscht einfach alle Zeilen wo die erste Spalte (sprich A1, A2, A3,...) nicht den Wert "Profile", "Setting ID_0x00a06946" oder "Setting ID_0x1095def8" hat. Keine Ahnung ob alle deine gespeicherten Profile die selben Settings aufweisen, aber erwähnen wollte ich es mal - zur Sicherheit.
 
Excel 2007.
Also das Buttonproblem lag daran, dass ein paar Komponenten nicht installiert waren. In den Profilen steckten noch Leerzeichen, also

Setting ID_0x1095def8

statt

Setting ID_0x1095def8

Soweit sogut, das geht jetzt. Aber das hier frisst er mir nicht:

"Profile *"

Es heißt ja nicht jedes Profil "Crysis 2". Kann ich keine Wildcard für den Profilnamen einsetzen?
 
Code: 
Option Explicit

Public Sub DelRow()
    Dim Last As Long
    Dim Row As Long
    Dim TextPos As Integer

    Application.ScreenUpdating = False
    Last = IIf(IsEmpty(Range("B65536")), Range("B65536").End(xlUp).Row + 1, 65536)
    
      For Row = Last To 1 Step -1
        TextPos = InStr(1, Cells(Row, 1), "Profile")
        
        If TextPos = 0 Then
            If LTrim(Cells(Row, 1)) <> "Setting ID_0x00a06946" And LTrim(Cells(Row, 1)) <> "Setting ID_0x1095def8" Then
                Cells(Row, 1).EntireRow.Delete
            End If
        End If
      Next
    Application.ScreenUpdating = True
End Sub

Aktzeptiert Leerzeichen, entfernt keine Zellen wo das Wort "Profile" drin vorkommt.

Nachtrag:
Code: 
Option Explicit

Public Sub DelRow()
    Dim Last As Long
    Dim Row As Long
    Dim TextPos As Integer
    Dim TextPosEnd As Integer

    Application.ScreenUpdating = False
    Last = IIf(IsEmpty(Range("B65536")), Range("B65536").End(xlUp).Row + 1, 65536)
    
      For Row = Last To 1 Step -1
        TextPos = InStr(1, Cells(Row, 1), "Profile")
        TextPosEnd = InStr(1, Cells(Row, 1), "EndProfile")
        
        If TextPos = 0 Or TextPosEnd <> 0 Then
            If LTrim(Cells(Row, 1)) <> "Setting ID_0x00a06946" And LTrim(Cells(Row, 1)) <> "Setting ID_0x1095def8" Then
                Cells(Row, 1).EntireRow.Delete
            End If
        End If
      Next
    Application.ScreenUpdating = True
End Sub
Entfernt auch die EndProfile-Zeile falls gewünscht.
 
Zuletzt bearbeitet:
Hm, dann behält er aber auch Zeilen mit
"Profile Type Application" und "Endprofile"

Ich brauche wirklich nur die Zeile mit dem Profilnamen.

Sorry, wenn ich nerve :)
 
Code: 
Option Explicit

Public Sub DelRow()
    Dim Last As Long
    Dim Row As Long
    Dim TextPos As Integer
    Dim TextPosEnd As Integer
    Dim TextPosApp As Integer

    Application.ScreenUpdating = False
    Last = IIf(IsEmpty(Range("B65536")), Range("B65536").End(xlUp).Row + 1, 65536)
    
      For Row = Last To 1 Step -1
        TextPos = InStr(1, Cells(Row, 1), "Profile")
        TextPosEnd = InStr(1, Cells(Row, 1), "EndProfile")
        TextPosApp = InStr(1, Cells(Row, 1), "Profile Type Application")
        
        If TextPos = 0 Or TextPosEnd <> 0 Or TextPosApp <> 0 Then
            If Trim(Cells(Row, 1)) <> "Setting ID_0x00a06946" And Trim(Cells(Row, 1)) <> "Setting ID_0x1095def8" Then
                Cells(Row, 1).EntireRow.Delete
            End If
        End If
      Next
    Application.ScreenUpdating = True
End Sub

So:
- entfernt alle Zeilen außer "Profile", "Setting ID_0x00a06946", "Setting ID_0x1095def8"
- entfernt auch "EndProfile" und "Profile Type Application"
- aktzeptiert Leerzeichen in Strings (am Anfang und am Ende)
 
Danke, klappt :)

Inzwischen hab ich ein neues "Problem", eher ein Kuriosum:

Ich habe folgende Tabelle mit SLI-Bits für verschiedene Spiele (beispielhaft):



Ich will, damit ich die Liste nachher ordentlich weiterverarbeiten kann, unter jedem Spiel Zeilen für DX10 und DX9 Bits stehen haben. Also 3 Zeilen pro Spiel, dann Leerzeile und dann der nächste Eintrag.

Spiel 1 hat nur Bits für DX10, Spiel 2 nur für DX9, Spiel 3 für DX9 und DX10 und Spiel 4 hat gar keine Bits.

Folgendes Makro hab ich geschrieben:

Code: 
Public Sub InsertBlankRow_DX9_DX10()
    Dim Last As Long
    Dim Row As Long
    Dim TextPosProf As Integer

    Application.ScreenUpdating = False
    Last = IIf(IsEmpty(Range("B65536")), Range("B65536").End(xlUp).Row + 1, 65536)
    
      For Row = Last To 1 Step -1
        TextPosProf = InStr(1, Cells(Row, 1), "Profile")
      
        If TextPosProf = 1 Then
           If (Cells(Row + 1, 1)) = "DX10" And (Cells(Row + 2, 1)) = "" Then
              Rows(Row + 2).Select
              Selection.Insert
              Cells(Row + 2, 1).Value = "DX9"
              Cells(Row + 2, 2).Value = "n/a"
           End If
           
           If (Cells(Row + 1, 1)) = "DX9" And (Cells(Row + 2, 1)) = "" Then
              Rows(Row + 1).Select
              Selection.Insert
              Cells(Row + 1, 1).Value = "DX10"
              Cells(Row + 1, 2).Value = "n/a"
           End If
           
           If (Cells(Row + 1, 1)) = "" Then
              Rows(Row + 1).Select
              Selection.Insert
              Selection.Insert
              Cells(Row + 1, 1).Value = "DX10"
              Cells(Row + 1, 2).Value = "n/a"
              Cells(Row + 2, 1).Value = "DX9"
              Cells(Row + 2, 2).Value = "n/a"
           End If
           
        End If
        
      Next
    Application.ScreenUpdating = True
End Sub

Für Spiel 1-3 klappt das auch wunderbar. Es wird eine Zeile (Spiel 1 und 2) bzw. keine Zeile (Spiel 3) mit den Einträgen hinzugefügt. Bei Spiel 4 aber passiert etwas, was ich partout nicht verstehe:

Sind die Zellen in dem blau markieren Bereich nicht leer, funktioniert das Makro. Sind sie aber leer, klappt es nicht! Ich brauch nur irgendwas da einfügen, egal wo - ein Wert reit - und es klappt. Warum ist das so?
 
Zuletzt bearbeitet:
Warum so kompliziert?

Excel- Spalte einfügen
Wennformel mit Bedingung das Text = "fettgedruckter text"
Bedingung wahr: 1
Bedingung falsch : 0

Dann ziehst du dir die Formel runter bis ans Ende. Sortierst absteigend und löscht alle Zeilen, wo eine 0 drin steht. Geht wesentlich schneller als VBA-Code zu schreiben und zu testen ;)

vg,
dagochen
 
Anmelden, um zu antworten.
Hardwareluxx setzt keine externen Werbe- und Tracking-Cookies ein. Auf unserer Webseite finden Sie nur noch Cookies nach berechtigtem Interesse (Art. 6 Abs. 1 Satz 1 lit. f DSGVO) oder eigene funktionelle Cookies. Durch die Nutzung unserer Webseite erklären Sie sich damit einverstanden, dass wir diese Cookies setzen. Mehr Informationen und Möglichkeiten zur Einstellung unserer Cookies finden Sie in unserer Datenschutzerklärung.


Zurück
Oben Unten refresh