Doppelte Wörter aus einer Zelle löschen

[Crissmusic]

Hallo zusammen,

ich habe eine Tabelle. Die Zellen A1-A100 und B1-B100 sind beschrieben.

Gibt es eine Möglichkeit die doppelten Wörter je Zelle zu löschen?
Oder ein export zu machen so das der text von A1 geprüft und nur die nicht doppelten Wörter in der Zelle C1 kopiert werden? Das gleich mit der B1-> Kopie der nicht doppelten Wörter in D1?

Liebe Grüße,
Chris

[steve1da]

Hola,

stehen mehrere Wörter in einer einzelnen Zelle, oder pro Zelle nur ein Wort?

Gruß,
steve1da

[Crissmusic]

Hallo Steve,

es stehen mehrere Werte (Wörter) in einer Zelle.

A1: Quelle
Das Auto war teuer, aber das Auto war schnell

-> Doppelte Wörter= Das, Auto, war

C1: Ausgabe ohne doppelte Wörter
Das Auto war teuer, aber schnell

[maninweb]

Hallo,

mit Formeln dürfte das recht schwierig sein. Mit VBA etwas einfacher. Anbei eine Prozedur, die die Doppler
ersetzt. Allerdings werden hier keine Satzzeichen berücksichtigt. "teuer," ist dann wie ein Wort. Vielleicht
ist dies schon ausreichend.

Code: Visual Basic

1.   Public Sub ReplaceDuplicates()
2.    
3.     Dim n As Long
4.     Dim p As Long
5.     Dim q As Long
6.    
7.     Dim h As Long
8.     Dim w As Long
9.     Dim x As Long
10.     Dim y As Long
11.    
12.     Dim d As Collection
13.     Dim t As String
14.     Dim r As Range
15.    
16.     Dim u As Variant
17.     Dim v As Variant
18.     Dim z As Variant
19.    
20. '   Errors...
21.    
22.     On Error Resume Next
23.    
24. '   Initialize...
25.    
26.     h = 100
27.     w = 2
28.     x = 1
29.     y = 1
30.    
31. '   Affected sheet...
32.    
33.     With ActiveSheet
34.      
35. '     Range...
36.      
37.       Set r = .Range(.Cells(y, x), .Cells(y + h - 1, x + w - 1))
38.      
39. '     Read...
40.      
41.       u = r.Value
42.      
43. '     Redim...
44.      
45.       ReDim v(LBound(u, 1) To UBound(u, 1), _
46.               LBound(u, 2) To UBound(u, 2))
47.      
48. '     Loop...
49.      
50.       For n = LBound(u, 1) To UBound(u, 1)
51.        
52.         For p = LBound(u, 2) To UBound(u, 2)
53.          
54. '         Check...
55.          
56.           If Len(u(n, p)) > 0 Then
57.            
58. '           Clear...
59.            
60.             Set d = New Collection
61.            
62. '           Split...
63.            
64.             z = Split(u(n, p), " ")
65.            
66. '           Loop...
67.            
68.             For q = LBound(z) To UBound(z)
69.            
70. '             Check...
71.              
72.               If Len(z(q)) > 0 Then
73.                
74. '               Try...
75.                
76.                 t = ""
77.                 t = d(LCase(z(q)))
78.                
79. '               Verify...
80.                
81.                 If Len(t) < 1 Then
82.                  
83. '                 Add...
84.                  
85.                   d.Add LCase(z(q)), LCase(z(q))
86.                  
87. '                 Append...
88.                  
89.                   v(n, p) = v(n, p) & " " & z(q)
90.                  
91.                 End If
92.                
93.               End If
94.              
95.             Next
96.            
97. '           Trim...
98.            
99.             v(n, p) = Trim(v(n, p))
100.            
101. '           Clear...
102.            
103.             Set d = Nothing
104.            
105.           End If
106.          
107.         Next
108.        
109.       Next
110.      
111. '     Write...
112.      
113.       r.Offset(0, w) = v
114.      
115.     End With
116.    
117.   End Sub

Die Prozedur in einem Modul ablegen. Diese bezieht sich auf das aktive Tabellenblatt. Ausführen kannst
Du z.B. das Makro über Ansicht / Makros / Makro Anzeigen oder indem Du eine AutoForm einfügst und dieser
das Makro zuordnest. Mache zuvor ein Backup Deiner Datei.

Gruß

[Crissmusic]

Mega Danke!
Hat funktioniert!