Thema Datum  Von Nutzer Rating
Antwort
14.10.2022 13:58:40 Jojo
NotSolved
Blau Excel doppelte Einträge (auch innerhalb einer Zeile) suchen und löschen
14.10.2022 15:32:08 Gast41904
*****
Solved
14.10.2022 16:20:50 Gast23944
NotSolved
14.10.2022 16:55:20 Gast41904
NotSolved

Ansicht des Beitrags:
Von:
Gast41904
Datum:
14.10.2022 15:32:08
Views:
887
Rating: Antwort:
 Nein
Thema:
Excel doppelte Einträge (auch innerhalb einer Zeile) suchen und löschen
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Option Explicit
 
Public Sub Test()
   
  Debug.Print "[START]"
   
  Dim dicTokenCache As Object
  Set dicTokenCache = CreateObject("Scripting.Dictionary")
   
  Dim dicTokens As Object
  Dim rngCell As Excel.Range
  Dim blnReplace As Boolean
  Dim tokens As Variant
  Dim token As Variant
   
  Set rngCell = Range("A1")
   
  Do While rngCell.Value <> ""
     
    'Zelleninhalt => Array => Dictionary
    tokens = Split(rngCell.Value, " ")
    Set dicTokens = CreateObject("Scripting.Dictionary")
    For Each token In tokens
      dicTokens(token) = Empty
    Next
     
    'Zelleninhalt prüfen
    For Each token In tokens
      If dicTokenCache.Exists(token) = False Then
        Call dicTokenCache.Add(Item:=rngCell.Address(0, 0), Key:=token)
      Else
        Debug.Print "["; rngCell.Address(0, 0); "] :: remove '"; token; _
                    "' (previously seen in: "; dicTokenCache(token); ")"
        'das 'token' haben wir schon vorher mal gesehen
        '=> 'token' entfernen
        Call dicTokens.Remove(token)
        blnReplace = True
      End If
    Next
     
    'falls oben 'token' entfernt wurden,
    'wird hier das Endergebnis zur in die Zelle geschrieben
    If blnReplace Then
      tokens = Join(dicTokens.Keys(), " ")
      Debug.Print "["; rngCell.Address(0, 0); "] :: change '"; rngCell.Value; "' to '"; tokens; "'"
      rngCell.Value = Join(dicTokens.Keys(), " ")
      blnReplace = False
    End If
     
    Set rngCell = rngCell.Offset(1)
  Loop
   
  Debug.Print "[DONE]"
   
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
14.10.2022 13:58:40 Jojo
NotSolved
Blau Excel doppelte Einträge (auch innerhalb einer Zeile) suchen und löschen
14.10.2022 15:32:08 Gast41904
*****
Solved
14.10.2022 16:20:50 Gast23944
NotSolved
14.10.2022 16:55:20 Gast41904
NotSolved