Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1564to1568
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

Code für Datenüberprüfung Ändern

Code für Datenüberprüfung Ändern
29.06.2017 08:15:10
Robin
Hallo,
ich habe mir diesen code hier geholt um bei den Dropdownlisten der Datenüberprüfung mehrere werte hintereinander schreiben zu können. Der funktioniert auch soweit einigermaßen. Ich will aber nicht jede Spalte einzeln eintragen müssen. Der code muss nämlich auf ca. 800 Spalten angewendet werden. (Alle spalten wäre auch ok.)
Hier der Code:
Const bolSorted As Boolean = True ' Legt fest, ob die Werte noch sortiert werden.
Dim blockedEvent As Boolean
Dim TargetOldText As String

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strResult As String
Dim strTarget As String
Dim arrSorted As Variant
Dim i As Long
If Target.Column = 5 Or TargetColumn = 6 Then
strTarget = Trim$(Target.Value)
If Not blockedEvent Then
blockedEvent = True
If Not TargetOldText = "" And Not Target.Value = "" Then
If InStr(1, TargetOldText, Target.Value) > 0 Then
strResult = Replace(TargetOldText, ", " & strTarget, "")
strResult = Replace(strResult, strTarget & ", ", "")
strResult = Replace(strResult, strTarget, "")
Else
strResult = TargetOldText & ", " & Target.Value
End If
If bolSorted Then
arrSorted = Split(strResult, ", ")
strResult = ""
Call Selectionsort(arrSorted)
For i = 0 To UBound(arrSorted)
strResult = strResult & arrSorted(i) & ", "
Next i
If Len(strResult) > 1 Then _
strResult = Left$(strResult, Len(strResult) - 2)
End If
Target.Value = strResult
Else
Target.Value = Target.Value
End If
TargetOldText = Target.Value
Else
blockedEvent = False
End If
Else
TargetOldText = ""
End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Column = TargetColumn Then
TargetOldText = Target.Value
End If
End Sub


Private Sub Selectionsort(ByRef data As Variant)
Dim OG&, i&, j&, k&, h As Variant
OG = UBound(data)
For i = 0 To OG - 1
h = data(i)
k = i
For j = i + 1 To OG
If data(j) 

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code für Datenüberprüfung Ändern
29.06.2017 09:06:25
Werner
Hallo Robin,
wenn ich dich richtig verstanden habe, dann meinst du den Spaltenbereich in dem sich der Code auswirken soll.
Dann z.B. so:
If Target.Column >= 3 And Target.Column = 15 And Target.Column 
Code wirkt sich aus im Spaltenbereich C (3) bis J (10) und O (15) bis T (20)
Gruß Werner
AW: Code für Datenüberprüfung Ändern
29.06.2017 09:12:32
Robin
Hallo,
danke für die schnelle Antwort. Das hat mir geholfen.
Gruß
Robin
Gerne u. Danke für die Rückmeldung. o.w.T.
29.06.2017 09:18:22
Werner
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige