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
Hallo Attila,
Hat funktioniert, danke!
Viele Grüße,
Robin
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
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
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 ...
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
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