Bei Klick auf die Kopfspalten Makro ausführen.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True If Target.Value = "" Then Exit Sub If Target.Row 7 Then Exit Sub If Target.Column = lngC Then blnOrder = IIf(blnOrder = 0, -1, 0) Else lngC = Target.Column blnOrder = -1 End If Range("D7").CurrentRegion.Sort Key1:=Target, Order1:=blnOrder + 2, Header:=xlYes End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True If Target.Value = "" Then Exit Sub If Target.Row 3 Then Exit Sub If Target.Column = lngC Then blnOrder = IIf(blnOrder = 0, -1, 0) Else lngC = Target.Column blnOrder = -1 End If Range("A3").CurrentRegion.Sort Key1:=Target, Order1:=blnOrder + 2, Header:=xlYes End Sub Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'E-mail Adresse durch Doppelklick auf die Spalte der E-Mail Adresse als E-Mail formatieren If IsValidMailAddress(Target) Then Cancel = True Me.Hyperlinks.Add Anchor:=Target, Address:="mailto:" & Target.Text, TextToDisplay:=Target. _ Text End If End Sub Private Function IsValidMailAddress(ByVal strAddress As String) As Boolean Dim oRegExp As Object Set oRegExp = CreateObject("vbscript.regexp") With oRegExp .Pattern = "[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|" & _ "}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:" & _ "[a-z0-9-]*[a-z0-9])?" .IgnoreCase = True IsValidMailAddress = .test(strAddress) End With Set oRegExp = Nothing End Function

Option Explicit Dim lngC As Long, blnOrder As Boolean Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Cancel = True If Target.Value = "" Then Exit Sub If Target.Row = 3 Then 'Doppelklick in Zeile 3 If Target.Column = lngC Then blnOrder = IIf(blnOrder = 0, -1, 0) Else lngC = Target.Column blnOrder = -1 End If Range("A3").CurrentRegion.Sort Key1:=Target, Order1:=blnOrder + 2, Header:=xlYes ElseIf Target.Column = 12 Then 'Doppelklick in Spalte L 'E-mail Adresse durch Doppelklick auf die Spalte der E-Mail Adresse als E-Mail formatieren If IsValidMailAddress(Target) Then Cancel = True Me.Hyperlinks.Add Anchor:=Target, Address:="mailto:" & Target.Text, TextToDisplay:= _ Target.Text End If End If End Sub Private Function IsValidMailAddress(ByVal strAddress As String) As Boolean Dim oRegExp As Object Set oRegExp = CreateObject("vbscript.regexp") With oRegExp .Pattern = "[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|" & _ "}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:" & _ "[a-z0-9-]*[a-z0-9])?" .IgnoreCase = True IsValidMailAddress = .test(strAddress) End With Set oRegExp = Nothing End Function

Muss mich revidieren, ich erweitere die Tabelle stetig, wenn ich ein Kriterium sortiere und dass dann bei anderen Spalten ebenfalls probiere, dann schmeißt er alle Daten durcheinander. Das geht nicht, es muss immer die gesamte Tabelle sortiert werden, egal ob Daten dazu kommen oder mehr spalten und bitte auch das Problem beachten, das ich im Post vorher angeschnitten habe
Außerdem gibts noch das Problem, wenn ich in die Spalten darüber also in Zeile 1 und 2 noch Formel reinbaue (in zeile 2 sollen noch Zähler kommen und in Spalte 1 Hyperlinks, dann macht er einen Fehler, nämlich er sortiert dann die zeile 3 mit, er soll aber erst ab zeile 4 anfangen Ich habe zum testen noch mal die aktuelle Datei mit dem Makro reingestellt
Schon mal Danke und Gruß

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim lZ As Long, lS As Long Cancel = True If Target.Value = "" Then Exit Sub If Target.Row = 3 Then 'Doppelklick in Zeile 3 lZ = Range("A" & Rows.Count).End(xlUp).Row 'letzte befüllte Zeile in Spalte A lS = Cells(3, Columns.Count).End(xlToLeft).Column 'letzte befüllte Spalte in zeile 3 If Target.Column = lngC Then blnOrder = IIf(blnOrder = 0, -1, 0) Else lngC = Target.Column blnOrder = -1 End If Range(Range("A3"), Cells(lZ, lS)).Sort Key1:=Target, Order1:=blnOrder + 2, Header:=xlYes ElseIf Target.Column = 12 Then 'Doppelklick in Spalte L 'E-mail Adresse durch Doppelklick auf die Spalte der E-Mail Adresse als E-Mail formatieren If IsValidMailAddress(Target) Then Cancel = True Me.Hyperlinks.Add Anchor:=Target, Address:="mailto:" & Target.Text, TextToDisplay:= _ Target.Text End If End If End Sub

Hallo,
mit nachstehendem Code wird bei einem Doppelklick auf "Name" die Spalte "Vorname" als 2. Sortierschlüsel aufgenommen. Wichtig ist, die Namensspalte muss in der Überschrift mit "Name" bezeichnet sein und der Vorname in der Spalte rechts daneben stehen. Solltest Du die Überschrift z.B. in "Nachname" ändern wollen (was mir persönlich besser gefallen würde), muss das Makro an der entsprechenden Stelle angepasst werden (If Target = "Vorname" Then). Alternativ kann diese Codezeile auch in If Target.Column = 3 Then geändert werden. Dann muss der Name immer in Spalte C und der Vorname in Spalte D stehen, dann wäre es egal, wie die Spalten in der überschriftenzeile heißen.
Da im Verlauf des Makros die letzte Spalte in der Zeile 3 und die letzte Zeile in der Spalte A ermittelt und die Sortierung auf diesen Bereich angewendet wird, müsste das ganze auch mit neuen Spalten und neuen Zeile funktionieren. Wichtig ist dann nur, dass die neuen Spalten eine Überschrift in der Zeile 3 erhalten und bei neuen Zeilen (also neuen Mitglieder) eine Mitgliedsnummer in der Spalte A vergeben wird.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim lZ As Long, lS As Long
Cancel = True
If Target.Value = "" Then Exit Sub
If Target.Row = 3 Then  'Doppelklick in Zeile 3
lZ = Range("A" & Rows.Count).End(xlUp).Row  'letzte befüllte Zeile in Spalte A
lS = Cells(3, Columns.Count).End(xlToLeft).Column 'letzte befüllte Spalte in zeile 3
If Target.Column = lngC Then
blnOrder = IIf(blnOrder = 0, -1, 0)
Else
lngC = Target.Column
blnOrder = -1
End If
'Bei Sortierung nach Namen wird der Vorname als 2. Sortierschlüssel aufgenommen,
'Bedingungen: 1. Spalte "Vorname" muss direkt rechts neben Spalte "Name" liegen,
'             2. Überschrift der Namensspalte muss "Name" lauten oder in nächster Zeile  _
angepasst werden
If Target = "Name" Then
Range(Range("A3"), Cells(lZ, lS)).Sort Key1:=Target, Order1:=blnOrder + 2, Key2:=Target. _
Offset(0, 1), Order2:=blnOrder + 2, Header:=xlYes
Else
Range(Range("A3"), Cells(lZ, lS)).Sort Key1:=Target, Order1:=blnOrder + 2, Header:= _
xlYes
End If
ElseIf Target.Column = 12 Then  'Doppelklick in Spalte L
'E-mail Adresse durch Doppelklick auf die Spalte der E-Mail Adresse als E-Mail formatieren
If IsValidMailAddress(Target) Then
Cancel = True
Me.Hyperlinks.Add Anchor:=Target, Address:="mailto:" & Target.Text, TextToDisplay:= _
Target.Text
End If
End If
End Sub

Gruß
Robert

Beliebteste Forumthreads (12 Monate)

Bei Klick auf die Kopfspalten Makro ausführen.

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread