PDA

Vollständige Version anzeigen : 2 Wörter pro Zelle auf Duplikate überprüfen.Reihenfolge egal


Michi2301
29.03.2012, 11:30
Hallo Forum,

ich möchte eine Excel Datei bearbeiten, bzw. geht es um eine Spalte dieser Datei. Die Zellen bestehen aus "Wort1 Wort2", aber leider auch "Wort2 Wort1"
Ich möchte die Datei gerne auf Duplikate überprüfuen. Dabei spielt die Reihenfolge der aufkommenden Wörter keine Rolle.

Also "tennis spielen" = "spielen tennis". In diesem Fall sollte "spielen tennis" markiert bzw. gelöscht werden.

Ich schlag mich schon den ganzen Vormittag damit rum und wäre über Hilfe sehr dankbar.

Vielen Dank schon mal.
Gruß Michi

pefeu
29.03.2012, 14:08
Hallo Michi,

das Makro färbt Dir die doppelten:
<Font Face="Courier New,FixedSys"Size=2><Blockquote><FONT COLOR=#0000FF>Option</FONT>&nbsp;<FONT COLOR=#0000FF>Explicit</FONT>

<FONT COLOR=#0000FF>Public</FONT>&nbsp;<FONT COLOR=#0000FF>Sub</FONT>&nbsp;Doppelte_raus()

<FONT COLOR=#0000FF>Dim</FONT>&nbsp;WkSh&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>As</FONT>&nbsp;Worksheet
<FONT COLOR=#0000FF>Dim</FONT>&nbsp;lZeile&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>As</FONT>&nbsp;<FONT COLOR=#0000FF>Long</FONT>
<FONT COLOR=#0000FF>Dim</FONT>&nbsp;rZelle&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>As</FONT>&nbsp;Range
<FONT COLOR=#0000FF>Dim</FONT>&nbsp;sFundst&nbsp;&nbsp;<FONT COLOR=#0000FF>As</FONT>&nbsp;<FONT COLOR=#0000FF>String</FONT>
<FONT COLOR=#0000FF>Dim</FONT>&nbsp;vTemp&nbsp;&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>As</FONT>&nbsp;<FONT COLOR=#0000FF>Variant</FONT>
&nbsp;
&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>Set</FONT>&nbsp;WkSh&nbsp;=&nbsp;ThisWorkbook.Worksheets("Tabelle1")&nbsp;<FONT COLOR=#008000>' den Tabellenblattnamen ggf. anpassen!</FONT>
&nbsp;&nbsp;&nbsp;
&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>For</FONT>&nbsp;lZeile&nbsp;=&nbsp;WkSh.Cells(Rows.Count,&nbsp;1).End(xlUp).Row&nbsp;<FONT COLOR=#0000FF>To</FONT>&nbsp;2&nbsp;<FONT COLOR=#0000FF>Step</FONT>&nbsp;-1
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>If</FONT>&nbsp;InStr(WkSh.Range("A"&nbsp;&amp;&nbsp;lZeile).Value,&nbsp;"&nbsp;")&nbsp;&gt;&nbsp;0&nbsp;<FONT COLOR=#0000FF>Then</FONT>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;vTemp&nbsp;=&nbsp;Split(WkSh.Range("A"&nbsp;&amp;&nbsp;lZeile).Value,&nbsp;"&nbsp;")
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>Set</FONT>&nbsp;rZelle&nbsp;=&nbsp;WkSh.Columns(1).Find(What:=vTemp(0),&nbsp;LookAt:=xlPart,&nbsp;LookIn:=xlValues, &nbsp;_
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SearchDirection:=xlPrevious,&nbsp;MatchCase:=<FONT COLOR=#0000FF>False</FONT>)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>If</FONT>&nbsp;<FONT COLOR=#0000FF>Not</FONT>&nbsp;rZelle&nbsp;<FONT COLOR=#0000FF>Is</FONT>&nbsp;<FONT COLOR=#0000FF>Nothing</FONT>&nbsp;<FONT COLOR=#0000FF>Then</FONT>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;sFundst&nbsp;=&nbsp;rZelle.Address
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>Do</FONT>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>If</FONT>&nbsp;rZelle.Row&nbsp;&lt;&gt;&nbsp;lZeile&nbsp;<FONT COLOR=#0000FF>And</FONT>&nbsp;_
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;InStr(WkSh.Range("A"&nbsp;&amp;&nbsp;rZelle.Row).Value,&nbsp;vTemp(1))&nbsp;&gt;&nbsp;0&nbsp;<FONT COLOR=#0000FF>Then</FONT>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;WkSh.Range("A"&nbsp;&amp;&nbsp;rZelle.Row).Interior.ColorIndex&nbsp;=&nbsp;44
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>End</FONT>&nbsp;<FONT COLOR=#0000FF>If</FONT>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>Set</FONT>&nbsp;rZelle&nbsp;=&nbsp;WkSh.Columns(1).FindPrevious(rZelle)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>Loop</FONT>&nbsp;<FONT COLOR=#0000FF>While</FONT>&nbsp;<FONT COLOR=#0000FF>Not</FONT>&nbsp;rZelle&nbsp;<FONT COLOR=#0000FF>Is</FONT>&nbsp;<FONT COLOR=#0000FF>Nothing</FONT>&nbsp;<FONT COLOR=#0000FF>And</FONT>&nbsp;rZelle.Address&nbsp;&lt;&gt;&nbsp;sFundst
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>End</FONT>&nbsp;<FONT COLOR=#0000FF>If</FONT>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>End</FONT>&nbsp;<FONT COLOR=#0000FF>If</FONT>
&nbsp;&nbsp;&nbsp;<FONT COLOR=#0000FF>Next</FONT>&nbsp;lZeile

<FONT COLOR=#0000FF>End</FONT>&nbsp;<FONT COLOR=#0000FF>Sub</FONT>
</Blockquote><Font Face="Courier New,FixedSys"Size=2>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Code eingefügt mit <b><a href="http://rtsoftwaredevelopment.de/SyntaxHi.zip">Syntaxhighlighter 1.14</a></b></Font><Font Size=2></p>
Gruß Peter

CitizenX
29.03.2012, 15:08
Hi
ich hätte da auch noch einen wenn es sich nur um 2 tauschbare Beriffe handelt:

Option Explicit

Sub deleteDobble()
Dim oDict As Object
Dim myRangeOut As Range
Dim myRange As Range, myCell As Range
Dim arrString, myString As String

Const inCol = 1 'Prüfspalte -anpassen
Set oDict = CreateObject("scripting.dictionary")
Set myRange = Columns(inCol).SpecialCells(xlCellTypeConstants)

For Each myCell In myRange
myString = Replace(myCell, " ", "")
If Not oDict.Exists(myString) Then oDict(myString) = vbNullString
arrString = Split(myCell)
If UBound(arrString) Then
myString = arrString(1) & arrString(0)
If Not oDict.Exists(myString) Then
oDict(myString) = vbNullString
Else
If myRangeOut Is Nothing Then Set myRangeOut = myCell
Set myRangeOut = Union(myRangeOut, myCell)
End If
End If
Next
If Not myRangeOut Is Nothing Then myRangeOut.Select 'myRangeOut.delete

End Sub