Hallo Leute,
kann mir jemand helfen mit der Rangsortierung . Es muß nach verschiedenen
Größen sortiert werden = 4 in der Anzahl ( Benutzerdefiniert ),
das heist natürlich mit Formeln.
Hallo Kay,
ich habe Ihnen die folgende Worksheet_BeforeRightClick-Prozedur in Ihre Arbeitsmappe eingefügt:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long
Dim maxZeile As Long
Dim rngAuswahl As Object
Dim rng(1 To 2) As Range
Dim zelle As Range
Dim zf As String
maxZeile = Me.Rows.Count
Set rngAuswahl = Selection
If TypeName(Selection) <> „Range“ Then
MsgBox Prompt:=“Bitte wählen Sie zwei komplette Zeilen aus.“
GoTo Ende
End If
If rngAuswahl.Areas.Count <> 2 Then
MsgBox Prompt:=“Bitte wählen Sie zwei komplette Zeilen aus.“
Exit Sub
End If
For i = 1 To 2
Set rng(i) = rngAuswahl.Areas(i)
If rng(i).Address <> rng(i).EntireRow.Address Then
MsgBox Prompt:=“Bitte wählen Sie jeweils komplette Zeilen aus.“
GoTo Ende
End If
Set rng(i) = rng(i).Resize(1, 10)
For Each zelle In rng(i).Cells
zf = BezugAbsolut(zelle.Formula)
If zf <> „“ Then
zelle.Formula = zf
End If
Next zelle
Next i
rng(1).Copy Destination:=Me.Cells(maxZeile, „A“)
rng(2).Copy
rng(1).PasteSpecial xlPasteFormulas
Me.Cells(maxZeile, „A“).Resize(1, 10).Copy
rng(2).PasteSpecial xlPasteFormulas
Application.CutCopyMode = xlCut
Me.Rows(maxZeile).Delete
rng(1).Resize(1, 1).Select
Ende:
Cancel = True
End Sub
Function BezugAbsolut(Formel As String) As String
Dim pos As Long
Dim zf1 As String
Dim zf2 As String
pos = InStrRev(Formel, „!“)
If pos = 0 Then
Exit Function
End If
zf1 = Left$(Formel, pos)
zf2 = Right$(Formel, Len(Formel) – pos)
zf2 = Me.Range(zf2).Address
BezugAbsolut = zf1 & zf2
End Function
Die Prozedur steht im Codemodul des betreffenden Tabellenblattes (Rechtsklick auf das Blattregister und „Code anzeigen“ auswählen).
Sie wenden die Prozedur folgendermaßen an:
Sie markieren die beiden zu vertauschenden Zeilen komplett (1. Zeile markieren, Strg-Taste festhalten und 2. Zeile markieren).
Dann machen Sie einen Rechtsklick auf irgendeine Zelle aus den beiden markierten Zeilen. Dadurch wird das Programm ausgelöst und die beiden Zeilen (im Bereich A bis J) werden vertauscht.
Die Zellen in dem zu vertauschenden Bereich enthalten Bezüge auf 2 verschiedene andere Arbeitsmappen. Diese Arbeitsmappen müssen verfügbar sein, damit das Programm arbeiten kann (Sie müssen nicht geöffnet sein).
Ein Teil der Bezüge ist relativ geschrieben, das macht beim Vertauschen Probleme. Das Programm ersetzt daher automatisch bei den zu vertauschenden Zeilen die relativen Bezüge durch absolute (d.h. es werden $-Zeichen hinzugefügt).
Ich bin jetzt bis Anfang September im Urlaub. Wenn es noch Nachfragen zu dem Programm gibt, dann kann ich mich leider erst Anfang September wieder darum kümmern.
Die ergänzte Arbeitsmappe finden Sie hier:
https://c.web.de/@309245993977646633/Sc9yEZ3eTTilFSBjx_I-rw
Viele Grüße und weiterhin viel Erfolg
Dieter Klemke