AW: Code kürzen
01.01.2019 21:07:33
Nepumuk
Hallo Alfred,
ich hab dir das doch schon mal gezeigt wie das geht. Aber gut, nochmal zwei Beispiele aus deinem Code:
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim lngIndex As Long
With ListBox1
For lngIndex = 1 To 144
Controls("TextBox" & CStr(lngIndex)).Text = .List(.ListIndex, lngIndex - 1)
Next
End With
FundZeile = ListBox1.List(Me.ListBox1.ListIndex, 144)
CommandButton1.Enabled = False ' den Ändern-Button freigeben
CommandButton3.Enabled = True
CommandButton4.Enabled = True ' den Löschen-Button freigeben
End Sub
Private Sub CommandButton1_Click()
Dim lLetzte As Long, lngIndex As Long
Dim iIndex As Integer
If TextBox1.Value = "" Then
MsgBox "Bitte Name eingeben - danke.", _
48, " Hinweis für " & Application.UserName
TextBox1.SetFocus
Exit Sub
End If
'
' die Daten sind geprüft und können in die Tabelle eingetragen werden
'
Application.ScreenUpdating = False
With Worksheets("Daten")
' .Unprotect Password:="Geheim"
lLetzte = IIf(.Range("A65536") <> "", 65536, .Range("A65536").End(xlUp).Row) + 1
If lLetzte < 2 Then lLetzte = 2
For lngIndex = 1 To 144
.Cells(lLetzte, lngIndex).Value = Controls("TextBox" & CStr(lngIndex)).Text
Next
' Tabelle nach "Betrieb" (Spalte1) mit Makro sortieren
Dim rngSort As Range
Dim ws As Worksheet
Dim lSpalte As Long
Dim c As Range
Dim strSuchbegriff As String
strSuchbegriff = "irgendwas"
Set ws = ActiveSheet 'Blatt festlegen
With ws
'letzte zu sortierende Spalte ermitteln
lSpalte = .Cells(1, .Cells.Columns.Count).End(xlToLeft).Column 'letze in Zeile '1' beschriebene Spalte
'erstmal alte Sortierreihenfolge löschen
.Sort.SortFields.Clear
Set rngSort = .Cells(1, lSpalte - 1)
Set rngSort = rngSort.CurrentRegion
'erste Sortierreihenfolge
.Sort.SortFields.Add _
Key:=Intersect(rngSort, .Columns(lSpalte - lSpalte + 1)), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
'weitere Sortierreihenfolge
.Sort.SortFields.Add _
Key:=Intersect(rngSort, .Columns(lSpalte - lSpalte + 2)), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
'jetzt Sortierung anwenden
With ws.Sort
.SetRange rngSort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
.Columns("A:EN").EntireColumn.AutoFit
Call Zeilen_faerben
With ListBox1
Call Array_fuellen
.Clear
.Column = aTmp
End With
' Label800.Caption = "Anzahl der Einträge: " & (lLetzte - 1)
End With
' Dim cb As Control
' For Each cb In UserForm1.Controls
' If TypeName(cb) = "TextBox" Or TypeName(cb) = "ComboBox" Then
' cb.Value = ""
' End If
' Next
For iIndex = 1 To 144
With Controls("TextBox" & iIndex)
.Value = ""
End With
Next iIndex
Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub
Gruß
Nepumuk