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.
10.02.2020, 02:13 (Dieser Beitrag wurde zuletzt bearbeitet: 10.02.2020, 02:13 von atilla.)
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:1 Nutzer sagt Danke an atilla für diesen Beitrag 28 • robinmathar
10.02.2020, 20:46 (Dieser Beitrag wurde zuletzt bearbeitet: 10.02.2020, 20:46 von robinmathar.)
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.
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.
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)
10.02.2020, 21:34 (Dieser Beitrag wurde zuletzt bearbeitet: 10.02.2020, 21:49 von atilla.)
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
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
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
