zwei kleine Probleme habe ich noch bei den schon recht gut funktionierenden Codes.
1.Das "
Sub sortieren" darf N U R im "Worksheets("Bearbeiten")" erfolgen. Eine versehentliche _
_
_
Ausführung in anderen Tabellen der Mappe hat fatale Folgen.
2. Das "
Sub sortieren" darf nur ausgeführt werden, wenn ... und nun kommt das komplizierte...
im "Worksheets("Bearbeiten" die Spalte "B" restlos nach unten befüllt ist, soweit wie der _
Bereich A-L befüllt ist. Also bis zur letzten ausgefüllten Zeile- egal ob
A; B; C; ... bis L --- eine ausgefüllte Zelle ist die letzte ausgefüllte Zeile.
Das Aufüllen wird über "
Sub Auffüllen" erledigt.
Es muss also erst "Aufgefüllt" werden, bevor sortiert werden darf.
Wie könnte man das voneinander abhängig machen, das erst die Bedingung der ausgefüllten Spalte " _
_
_
B" erfüllt sein muss, bevor das Makro "Sortieren" starten darf.
Option Explicit
Sub sortieren()
If MsgBox("soll wirklich der Tabelleninhalt sortiert werden?", vbQuestion + vbYesNo) = vbYes _
_
_
Then
Dim a ' ohne Angabe = as Variant, unten als "Array"
Dim z&, zMax& ' & = as long
Const vonSp = "B", bisSp = "L"
zMax = Range(vonSp & Rows.Count).End(xlUp).Row ' unterste Zeile
' 1. Unterschiedliche Schreibweisen der Zimmer-Nr. rauswerfen
' Zi. 24, Zi .24, Zi.24 werden alle zu Zi.24
a = Range("B1").Resize(zMax) ' Array aus Bereich einlesen
For z = 1 To zMax
If Left(a(z, 1), 1) = "Z" Then a(z, 1) = Replace(a(z, 1), " ", "")
Next
Range("B1").Resize(zMax) = a ' Array in Bereich zurückschreiben
' 2. Sortieren B:L nach C
Range(vonSp & "1:" & bisSp & zMax).Sort _
Range(vonSp & "1"), xlAscending, _
Range("C1"), , xlAscending, Header:=xlNo
' 3. Sortieren B:L nach E
Range(vonSp & "1:" & bisSp & zMax).Sort _
Range(vonSp & "1"), xlAscending, _
Range("E1"), , xlAscending, Header:=xlNo
MsgBox "Sortiert"
End If
End Sub
Sub Auffüllen()
If MsgBox("mit JA werden fehlende Werte in B aufgefüllt", vbQuestion + vbYesNo) = vbYes Then
Dim rngZelle As Range
Dim rngBereich As Range
Dim wksBlatt As Worksheet
Set wksBlatt = ThisWorkbook.Worksheets("Bearbeiten")
With wksBlatt
Set rngBereich = .Range("B1:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For Each rngZelle In rngBereich
If IsEmpty(rngZelle) = True Then
rngZelle.Value = rngZelle.Offset(-1, 0).Value
End If
Next rngZelle
End With
End If
End Sub
hier mal eine Beispielmappe
https://www.herber.de/bbs/user/111938.xlsm
LG Andi