Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1112to1116
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bereich nicht C:E, sondern C+E - wie ändern?

Bereich nicht C:E, sondern C+E - wie ändern?
Wolfgang
Hallo,
der nachstehende Code dient dazu, eine Tabelle nach doppelten Datensätzen zu überprüfen. Indikator sind Spalte C und Spalte E; Wie kann ich den nachstehenden Code abändern, damit die Spalte D ausgeklammert wird, da hierin enthaltene Daten unterschiedlich sein können. Abgfragt werden soll dabei, ob in Kombination in Spalte C und E Datensätze doppelt vorkommen. Danke schon jetzt für die Rückmeldungen.
Gruß - Wolfgang
Sub compareRanges()
Dim objWsA As Worksheet, objWsB As Worksheet
Dim rngA As Range, rngB As Range
Dim strA As String, strB As String, strSheet As String
Dim lngRow As Long, lngIndex As Long
Dim varRes As Variant
Application.ScreenUpdating = False
Call BlattschutzRaus
Sheets("Daten").Select
Columns("R:R").Select
Selection.ClearContents
Do
'Beep
strSheet = "Daten"
If strSheet = "" Then Exit Sub
If SheetExist(strSheet) Then Exit Do
Loop
Set objWsA = Sheets(strSheet)
Do
'Beep
strSheet = "Daten"
If strSheet = "" Then Exit Sub
If SheetExist(strSheet) Then Exit Do
Loop
Set objWsB = Sheets(strSheet)
Set rngA = objWsA.Range("C2:E" & Application.Max(objWsA.Cells(Rows.Count, 5).End(xlUp).Row,  _
_
2))
Set rngB = objWsB.Range("C2:E" & Application.Max(objWsB.Cells(Rows.Count, 5).End(xlUp).Row,  _
_
2))
For lngIndex = 1 To rngB.Columns.Count
strB = strB + rngB.Parent.Name & "!" & rngB.Columns(lngIndex).Address & "&"
Next
strB = Left(strB, Len(strB) - 1)
For lngRow = 1 To rngA.Rows.Count
strA = ""
For lngIndex = 1 To rngA.Columns.Count
strA = strA + rngA.Parent.Name & "!" & rngA.Cells(lngRow, lngIndex).Address & "&"
Next
strA = Left(strA, Len(strA) - 1)
If objWsA Is objWsB Then
varRes = Evaluate("SUM(N(" & strB & "=" & strA & "))")
If varRes >= 2 Then
varRes = Evaluate("MATCH(" & strA & "," & strB & ",0)")
Else
varRes = ""
End If
Else
varRes = Evaluate("MATCH(" & strA & "," & strB & ",0)")
End If
If IsNumeric(varRes) Then
rngA.Parent.Hyperlinks.Add _
Anchor:=rngA.Cells(lngRow, rngA.Columns.Count).Offset(0, 13), _
Address:="", _
SubAddress:=rngB.Parent.Name & "!" & rngB.Rows(varRes).Address, _
TextToDisplay:="Datensatz doppelt!"
End If
Next
Set objWsA = Nothing
Set objWsB = Nothing
Set rngA = Nothing
Set rngB = Nothing
Range("A1").Select
Call BlattschutzRein
Application.ScreenUpdating = True
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Bereich nicht C:E, sondern C+E - wie ändern?
31.10.2009 20:25:12
fcs
Hallo Wolfgang,
im Schleifenzähler für die Spalten muss dann jeweils die 2. Spalte übersprungen werden. Das kann man über eine entsprechende If-Anweisung erreichen.
Gruß
Franz
Sub compareRanges()
Dim objWsA As Worksheet, objWsB As Worksheet
Dim rngA As Range, rngB As Range
Dim strA As String, strB As String, strSheet As String
Dim lngRow As Long, lngIndex As Long
Dim varRes As Variant
Application.ScreenUpdating = False
Call BlattschutzRAUS
Sheets("Daten").Select
Columns("R:R").Select
Selection.ClearContents
Do
'Beep
strSheet = "Daten"
If strSheet = "" Then Exit Sub
If SheetExist(strSheet) Then Exit Do
Loop
Set objWsA = Sheets(strSheet)
Do
'Beep
strSheet = "Daten"
If strSheet = "" Then Exit Sub
If SheetExist(strSheet) Then Exit Do
Loop
Set objWsB = Sheets(strSheet)
Set rngA = objWsA.Range("C2:E" & _
Application.Max(objWsA.Cells(Rows.Count, 5).End(xlUp).Row, 2))
Set rngB = objWsB.Range("C2:E" & _
Application.Max(objWsB.Cells(Rows.Count, 5).End(xlUp).Row, 2))
For lngIndex = 1 To rngB.Columns.Count
If lngIndex  2 Then                               '####neu
strB = strB + rngB.Parent.Name & "!" & rngB.Columns(lngIndex).Address & "&"
End If                                              '####neu
Next
strB = Left(strB, Len(strB) - 1)
For lngRow = 1 To rngA.Rows.Count
strA = ""
For lngIndex = 1 To rngA.Columns.Count
If lngIndex  2 Then                               '####neu
strA = strA + rngA.Parent.Name & "!" & rngA.Cells(lngRow, lngIndex).Address & "&"
End If                                              '####neu
Next
strA = Left(strA, Len(strA) - 1)
If objWsA Is objWsB Then
varRes = Evaluate("SUM(N(" & strB & "=" & strA & "))")
If varRes >= 2 Then
varRes = Evaluate("MATCH(" & strA & "," & strB & ",0)")
Else
varRes = ""
End If
Else
varRes = Evaluate("MATCH(" & strA & "," & strB & ",0)")
End If
If IsNumeric(varRes) Then
rngA.Parent.Hyperlinks.Add _
Anchor:=rngA.Cells(lngRow, rngA.Columns.Count).Offset(0, 13), _
Address:="", _
SubAddress:=rngB.Parent.Name & "!" & rngB.Rows(varRes).Address, _
TextToDisplay:="Datensatz doppelt!"
End If
Next
Set objWsA = Nothing
Set objWsB = Nothing
Set rngA = Nothing
Set rngB = Nothing
Range("A1").Select
Call BlattschutzREIN
Application.ScreenUpdating = True
End Sub

Anzeige
Danke, Franz!
01.11.2009 10:45:20
Wolfgang
Hallo Franz,
erneut herzlichen Dank für Deine Rückmeldung und Ausarbeitungen. Ich hatte schon verschiedene Dinge getestet, aber ohne Erfolg. Umsomehr freut mich Deine Rückmeldung. Der Code läuft einwandfrei. Hab nochmals recht herzlichen Dank dafür.
Gruß und einen schönen Sonntag noch.
Wolfgang

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige