Rückgäng machen nach VBA Ausführung
20.06.2009 16:32:24
chris58
Ich habe diesen Code in den weiten des Internet gefunden. Da ich kaum Kenntnisse mittels VBA habe, möchte ich erfahren, ob es eine Möglichkeit gibt, nach Ausführung dieses VBA-Codes und Löschung der doppelten Datensätze den Code irgenwie wieder rückgängig zu machen.
Es wäre nicht nötig, aber da ich eine "bedingte Formartierung" in der Spalte C habe (die für die Suche erforderlich ist, den da stehen die Namen), die jede zweite Zeile in einer Farbe einfärbt wäre es gut, wenn die Optik gewahrt bliebe. Kann mir wer helfen, wie man das machen kann.
Danke für Eure Antworten
chris58
Option Explicit
Sub Doppelte_Werte_nach_Spaltenauswahl_markieren()
Dim i As Long
Dim j As Long
Dim k As Integer
Dim F As Integer
Dim dic As Object
Dim strKey As String
Dim FromRow As Long
Dim ToRow As Long
Dim Eingabe As String
Dim SuchCol As Variant
Dim FarbCol As Variant
Set dic = CreateObject("scripting.dictionary")
'Such-Art wird angegeben und Zeilen (von/Bis) und Spalten angegeben
If MsgBox("Wollen Sie eine Standardsuche durchführen?", vbYesNo + vbQuestion, " _
Duplikatsuche") = vbYes Then
'Standartsucheigenschaften werden festgelegt
ReDim FarbCol(1 To 1)
ReDim SuchCol(1 To 1)
FromRow = 1
ToRow = InputBox("Bis zu welcher Zeile soll gesucht werden?", , ActiveCell.Row)
SuchCol(1) = ActiveCell.Column
FarbCol(1) = ActiveCell.Column
Else
'Erweiterte Sucheigenschaften werden eingegeben
Eingabe = InputBox("Ab welcher Zeile soll gesucht werden?")
If IsNumeric(Eingabe) Then
If CLng(Eingabe) > 0 And CLng(Eingabe)
Function strCol_To_intCol(WSName As String, StrRng As String) As Variant
Dim i As Long
Dim j As Long
Dim Merker As Variant
Dim ind As String
Dim HelpStr As String
Dim HelpArr As Variant
Dim FarbCol As Variant
Dim FCol As String
Dim TCol As String
i = 0
Do Until i = Len(StrRng)
HelpStr = ""
Do
i = i + 1
HelpStr = HelpStr & Mid(StrRng, i, 1)
Loop Until KindOfStr(HelpStr) = "Sig" Or Len(StrRng) 0 Then
FCol = Replace(Replace(HelpStr, ",", ""), "-", "")
End If
Else
If Len(Replace(Replace(HelpStr, ",", ""), "-", "")) > 0 Then
TCol = Replace(Replace(HelpStr, ",", ""), "-", "")
End If
End If
If FCol "" And TCol "" Then
If Not IsNumeric(FCol) Then If Not IsError(Columns(FCol).Column) Then FCol = _
Columns(FCol).Column Else: GoTo ErrorHandle
If Not IsNumeric(TCol) Then If Not IsError(Columns(TCol).Column) Then TCol = _
Columns(TCol).Column Else: GoTo ErrorHandle
If CDbl(FCol) > CDbl(TCol) Then
Merker = TCol
TCol = FCol
FCol = Merker
Merker = ""
End If
For j = FCol To TCol
If Not IsArray(HelpArr) Then
ReDim HelpArr(1 To 1)
Else
ReDim Preserve HelpArr(1 To UBound(HelpArr) + 1)
End If
HelpArr(UBound(HelpArr)) = j
Next
FCol = ""
TCol = ""
ElseIf FCol = "" And TCol "" Then
If Not IsNumeric(TCol) Then If Not IsError(Columns(TCol).Column) Then TCol = _
Columns(TCol).Column Else: GoTo ErrorHandle
If Not IsArray(HelpArr) Then
ReDim HelpArr(1 To 1)
Else
ReDim Preserve HelpArr(1 To UBound(HelpArr) + 1)
End If
HelpArr(UBound(HelpArr)) = CDbl(TCol)
TCol = ""
End If
Loop
strCol_To_intCol = HelpArr
Exit Function
If IsArray(HelpArr) Then
With Worksheets(WSName)
For i = LBound(HelpArr) To UBound(HelpArr)
If strCol_To_intCol Is Nothing Then
Set strCol_To_intCol = .Columns(HelpArr(i))
Else
Set strCol_To_intCol = Union(strCol_To_intCol, .Columns(HelpArr(i)))
End If
Next
End With
End If
Exit Function
ErrorHandle:
MsgBox "Fehhler in der Gegend von " & HelpStr
End Function
Function KindOfStr(Str As String) As String
If Len(CStr(Replace(Str, ",", ""))) Len(Str) Or Len(CStr(Replace(Str, "-", ""))) Len( _
Str) Then
KindOfStr = "Sig"
ElseIf Str Like "[A-Z,a-z]" Then
KindOfStr = "Str"
ElseIf IsNumeric(Str) Then
KindOfStr = "Num"
Else
Stop
End If
End Function