Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Zellen löschen, wenn Wert nicht in Liste
#1
Hallo zusammen,

ich habe leider schon wieder ein Problem bei dem ich eure Hilfe benötige. Ich habe ein Blatt mit insgesamt 40.000 Keywords in einzelnen Zellen auf 5000 Zeilen und ungefähr 100 Spalten sehr ungleichmäßig verteilt. Die Reihenfolge muss genau so beibehalten bleiben, da ich sie so weiterverarbeiten muss.

Ich habe jetzt eine Auswahl an 24 Keywords, die in diesen 40.000 Keywords vorkommen. Ich will nun alle anderen Zellen, die andere Werte als einen dieser 24 löschen. Ich habe eine Beispieldatei angehangen. In Tabelle 1 sind die 40.000 Keywords, in Tabelle 2 die Liste der 24 Keywords die beibehalten bleiben sollen.

Vielen Dank vorab und viele Grüße,
Robin


Angehängte Dateien
.xlsx   Zellinhalte mit Bedingung löschen.xlsx (Größe: 396,84 KB / Downloads: 4)
Antworten Top
#2
Hallo,

teste mal:

Code:
Sub löschen()
Dim i As Long, lngR As Long
Dim j As Long, lngC As Long

Dim varKey
Dim varTab

varKey = Sheets("Tabelle2").Range("A1:A24").Value

With Sheets("Tabelle1")
   varTab = .UsedRange
   lngR = .UsedRange.Rows.Count
   lngC = .UsedRange.Columns.Count
End With

For i = 1 To lngR
   For j = 1 To lngC
      If IsError(varTab(i, j)) Then
         varTab(i, j) = ""
         j = j + 1
      End If
      If varTab(i, j) <> "" Then
         If Not IsNumeric(Application.Match(varTab(i, j), varKey, 0)) Then varTab(i, j) = ""
      End If
   Next j
Next i

Sheets("Tabelle1").UsedRange = varTab

End Sub
Gruß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • robinmathar
Antworten Top
#3
Hallo Attila,

Hat funktioniert, danke!

Viele Grüße,
Robin
Antworten Top
#4
Hallo Attila,
ich habe jetzt doch noch einmal ein Problem. Ich musste durch einige unsaubere Daten das ganze nochmal durchführen und jetzt gibt er mir den Fehler 2029 und "Laufzeitfehler 13: Typen unvereinbar" für die rot markierte Zeile:
Sub löschen()
Dim i As Long, lngR As Long
Dim j As Long, lngC As Long

Dim varKey
Dim varTab

varKey = Sheets("Tabelle2").Range("A1:A24").Value

With Sheets("Tabelle1")
  varTab = .UsedRange
  lngR = .UsedRange.Rows.Count
  lngC = .UsedRange.Columns.Count
End With

For i = 1 To lngR
  For j = 1 To lngC
      If IsError(varTab(i, j)) Then
        varTab(i, j) = ""
        j = j + 1
      End If
      If varTab(i, j) <> "" Then
        If Not IsNumeric(Application.Match(varTab(i, j), varKey, 0)) Then varTab(i, j) = ""
      End If
  Next j
Next i

Sheets("Tabelle1").UsedRange = varTab

End Sub

Das einzige was ich geändert habe ist die Reihenfolge der Keywords in der ersten Tabelle, also die mit den 40.000 Keywords und habe entsprechend ein paar Keywords verändert. Aber das dürfte für die Formel ja nicht entscheidend sein oder? Die "neue" Datei habe ich angehangen.

Vielen Dank vorab und viele Grüße,
Robin


Angehängte Dateien
.xlsx   Alles bis auf keywords löschen.xlsx (Größe: 402,5 KB / Downloads: 1)
Antworten Top
#5
Hallo zusammen,

ich habe jetzt doch noch einmal ein Problem, dass ich dachte schon gelöst zu haben. Ich habe die unten angehangene Datei und versuche dabei alle Zellen in Tabelle1 zu löschen, die nicht einen der Werte aus der Liste in Tabelle2 besitzen. Das hat gestern mit dem folgenden Code auch schonmal geklappt, ich musste allerdings die Daten nochmal überarbeiten und jetzt gibt er mir den Fehler 2029 und "Laufzeitfehler 13: Typen unvereinbar" für die rot markierte Zeile:
Sub löschen()
Dim i As Long, lngR As Long
Dim j As Long, lngC As Long

Dim varKey
Dim varTab

varKey = Sheets("Tabelle2").Range("A1:A24").Value

With Sheets("Tabelle1")
  varTab = .UsedRange
  lngR = .UsedRange.Rows.Count
  lngC = .UsedRange.Columns.Count
End With

For i = 1 To lngR
  For j = 1 To lngC
      If IsError(varTab(i, j)) Then
        varTab(i, j) = ""
        j = j + 1
      End If
      If varTab(i, j) <> "" Then
        If Not IsNumeric(Application.Match(varTab(i, j), varKey, 0)) Then varTab(i, j) = ""
      End If
  Next j
Next i

Sheets("Tabelle1").UsedRange = varTab

End Sub

Das einzige was ich geändert habe ist die Reihenfolge der Keywords in der ersten Tabelle, also die mit den 40.000 Keywords und habe entsprechend ein paar Keywords verändert.

Könnt ihr mir dabei helfen? Ist leider sehr sehr dringend für meine Abschlussarbeit.

Vielen Dank vorab und viele Grüße,
Robin


Angehängte Dateien
.xlsx   Alles bis auf keywords löschen.xlsx (Größe: 402,5 KB / Downloads: 0)
Antworten Top
#6
hallöchen,

ich vermute mal, Du schießt über Dein Ziel hinaus.
nimm mal den Schleifenzähler in die Überwachung und vergleiche ihn bei Auftreten des Fehlers mit der Variable lngc. j sollte nicht größer sein ...
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#7
Hallo,

diesen Fehler sollten eigentlich diese Zeilen im Code abfangen:

Code:
      If IsError(varTab(i, j)) Then
        varTab(i, j) = ""
        j = j + 1
      End If


Da aber mehrere Zellen hintereinander Fehler aufweisen, (Zellen mit Formeln die den Fehler "#Name?" enthalten) funktioniert es so nicht.
Man könnte zwar mir Resume Next an der Stelle weitermachen aber muss nicht.

Dann eben so:

Code:
Sub löschen()
Dim i As Long, lngR As Long
Dim j As Long, lngC As Long

Dim varKey
Dim varTab

varKey = Sheets("Tabelle2").Range("A1:A24").Value

With Sheets("Tabelle1")
  lngR = .UsedRange.Rows.Count
  lngC = .UsedRange.Columns.Count
  On Error Resume Next
  .UsedRange.SpecialCells(xlCellTypeFormulas, 16).Clear  'weil, bei keinen Fundstellen der Code in einen Fehler laufen würde
   On Error GoTo 0
   varTab = .UsedRange.Value
End With

For i = 1 To lngR
  For j = 1 To lngC
      If varTab(i, j) <> "" Then
        If Not IsNumeric(Application.Match(varTab(i, j), varKey, 0)) Then varTab(i, j) = ""
      End If
  Next j
Next i

Sheets("Tabelle1").UsedRange = varTab

End Sub
Gruß Atilla
Antworten Top
#8
Wieso geht es jetzt hier weiter?
https://www.clever-excel-forum.de/Thread...t-in-Liste
Schöne Grüße
Berni
Antworten Top
#9
Danke für deine Antwort!

Jetzt führt das Makro leider gar nichts aus.. Gibt keinen Fehler, aber es passiert auch nichts.

Kann es an der Codedarstellung liegen? Habe ich das so richtig getrennt:

Code:
Sub löschen()

Dim i As Long, lngR As Long
Dim j As Long, lngC As Long
Dim varKey
Dim varTab

varKey = Sheets("Tabelle2").Range("A1:A24").Value

With Sheets("Tabelle1")
  lngR = .UsedRange.Rows.Count
  lngC = .UsedRange.Columns.Count
  On Error Resume Next
  .UsedRange.SpecialCells(xlCellTypeFormulas, 16).Clear  'weil, bei keinen Fundstellen der Code in einen Fehler laufen würde
   On Error GoTo 0
   varTab = .UsedRange
End With

For i = 1 To lngR
  For j = 1 To lngC
      If varTab(i, j) <> "" Then
        If Not IsNumeric(Application.Match(varTab(i, j), varKey, 0)) Then varTab(i, j) = ""
      End If
  Next j
Next i

End Sub

Viele Grüße,
Robin
Antworten Top
#10
Hallo,

vor End Sub fehlt diese Zeile:

Code:
Sheets("Tabelle1").UsedRange = varTab
Gruß Atilla
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste