UserForm - Format übernehmen + Einsortieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub CommandButton1_Click() Dim lZeile As Long lZeile = 6 Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) "" lZeile = lZeile + 1 Loop Tabelle1.Cells(lZeile, 1) = CStr("Neuer Eintrag Zeile " & lZeile) ListBox1.AddItem CStr("Neuer Eintrag Zeile " & lZeile) ListBox1.ListIndex = ListBox1.ListCount - 1 End Sub

Private Sub CommandButton1_Click() Dim lZeile As Long With Tabelle1 lZeile = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte Zeile bestimmen .Cells(lZeile, 1).EntireRow.Copy 'ganze Zeile kopieren .Cells(lZeile + 1, 1).EntireRow.PasteSpecial xlPasteFormats 'ab Spalte A einfügen, aber nur _ Formate Application.CutCopyMode = False 'Kopierameisen abschalten .Cells(lZeile + 1, 1) = CStr("Neuer Eintrag Zeile " & lZeile) ListBox1.AddItem CStr("Neuer Eintrag Zeile " & lZeile) ListBox1.ListIndex = ListBox1.ListCount - 1 End With End Sub

Hallo Klaus,
vielen Dank für Deine Antwort. Du hast mir sehr geholfen und ich bin ein schritt weitergekommen - habe den Befehl etwas erweitern müssen.
Zwei Probleme bestehen allerdings noch:
1.) in der jetzigen Form werden auch die Inhalte der vorherigen Zeile mit übernommen - ich möchte allerdings nur das Format und die Formel übernehmen. Ich weiß, dass dies über den Befehl '.SpecialCells(xlCellTypeConstants).ClearContents' geht. Wie kann ich diesen in mein bestehendes Makro einbauen?

Private Sub CommandButton1_Click()
Dim lZeile As Long
With Tabelle1
lZeile = .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte Zeile bestimmen
.Cells(lZeile, 1).EntireRow.Copy 'ganze Zeile kopieren
.Cells(lZeile, 1).Insert xlDown
.Cells(lZeile + 1, 1).EntireRow.PasteSpecial xlPasteFormats
.Cells(lZeile + 1, 1).EntireRow.PasteSpecial xlPasteFormulas
Application.CutCopyMode = False 'Kopierameisen abschalten
.Cells(lZeile + 1, 1) = CStr("Neuer Eintrag Zeile " & lZeile)
ListBox1.AddItem CStr("Neuer Eintrag Zeile " & lZeile)
ListBox1.ListIndex = ListBox1.ListCount - 1
End With
End Sub

2.) Ich hänge immer noch bei der Sortierfunktion, da ich diese in mein Makro zum speichern eines neuen Eintrages integrieren möchte. Mit dem Speichern eines Eintrages soll die gesamte Liste neu sortiert werden nach einem Startdatum, welches in Spalte I befindlich ist.

Private Sub CommandButton4_Click()
Dim lZeile As Long
If ListBox1.ListIndex = -1 Then Exit Sub
If Trim(CStr(TextBox1.Text)) = "" Then
MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
Exit Sub
End If
lZeile = 6
Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value))  ""
If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) Then
Tabelle1.Cells(lZeile, 1).Value = Trim(CStr(TextBox1.Text))
Tabelle1.Cells(lZeile, 25).Value = TextBox2.Text
Tabelle1.Cells(lZeile, 26).Value = TextBox3.Text
Tabelle1.Cells(lZeile, 27).Value = TextBox4.Text
If ListBox1.Text  Trim(CStr(TextBox1.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do
End If
lZeile = lZeile + 1
Loop
End Sub

Dim lZeile As Long With Tabelle1 lZeile = .Cells(.Rows.Count, 1).End(xlUp).Row .Cells(lZeile, 1).EntireRow.Copy .Cells(lZeile, 1).Insert xlDown .Cells(lZeile + 1, 1).EntireRow.PasteSpecial xlPasteFormats .Cells(lZeile + 1, 1).EntireRow.PasteSpecial xlPasteFormulas .Cells(lZeile + 1, 1).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents Application.CutCopyMode = False .Cells(lZeile + 1, 1) = CStr("Neuer Eintrag Zeile " & lZeile) ListBox1.AddItem CStr("Neuer Eintrag Zeile " & lZeile) ListBox1.ListIndex = ListBox1.ListCount - 1 End With

Hi,
deine Namensgebung ist ja furchtbar! Wenn du einen Button hast der einen neuen Beitrag einfügt, dann nenne den nicht "CommandButton1" - sondern nenn den um in "Cmb_BeitragNeu". Das gleiche gilt für alle anderen Objekte - nenne die ListBox nicht "ListBox1", sondern "ListBox_VorhandeneEintraege". Solange du nur ein oder zwei Buttons hast, ist das nur unnötiger Mehraufwand - aber wenn das Projekt wächst (und deins ist ja schon relativ groß) erschwerst du dir das debuggen unnötig.
Beispiel: ich bin grad in
Private Sub CommandButton4_Click()
was genau macht der nochmal? Hättest du den gleich in "Cmb_Speichern" umbenannt, siehst du beim coden gleich
Private Sub Cmb_Speichern_Click()
und weisst genau was du gerade machst. Gleiches für die Listbox: was exakt macht denn die Zeile
If ListBox1.ListIndex = -1 Then Exit Sub da?
Mit guter Namensvergabe sehe und verstehe ich sofort:
If ListBox_VorhandeneEintraege.ListIndex = -1 Then Exit Sub
aha! Wenn kein Eintrag gewählt wurde, dann brich das Makro ab. NOCH scheint das pedantisch zu sein - aber was machst du, wenn dein nächstes Projekt mal 27 verschiedene Listboxen hat? Dann verlierst du komplett den Überblick!
Das "Exit Sub" ein schlimmes Kommando ist dass ich aus Prinzip vermeiden würde, hier nur als Einschub.
Ich leb jetzt damit und benenne nichts um - die Fleißarbeit lasse ich dir. Aber mach sie dir und gewöhne sie dir an, als gutgemeinter Rat. Stell dir mal vor die Datei wird 3 Jahre benutzt, und dann wirst du zum debuggen geholt - erinnerst du dich dann noch daran, was ListBox1 jetzt war?
Achso, KOMMENTARE. Kommentare in den Code. Viele. Das hilft ungemein beim Nachvollziehen. Mindestens eine Klartextbeschreibung am Anfang jedes Codeteils, zum Beispiel:
'Button speichert bei korrekter Auswahl eines Eintrages, sortiert vorher nach Kalenderwochen
So weisst du gleich im Klartext was dein Code machen soll und musst dich weniger reinlesen.
LG,
Klaus

Sub SortiereKW() '### sortiere Tabelle1 nach Kalenderwochen, bevor gespeichert wird Dim letzteZeile As Long Const ersteZeile As Long = 5 'Überschriften in Zeile 5 Const sortiereSpalte As Long = 9 'nach Spalte 9 = I sortieren With Worksheets("Tabelle1") letzteZeile = .Cells(.Rows.Count, sortiereSpalte).End(xlUp).Row .Sort.SortFields.Clear .Sort.SortFields.Add Key:=.Range(.Cells(ersteZeile, sortiereSpalte), .Cells(letzteZeile, _ sortiereSpalte)), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers .Sort.SetRange .Range("A" & ersteZeile & ":AZ" & letzteZeile) .Sort.Header = xlYes .Sort.MatchCase = False .Sort.Orientation = xlTopToBottom .Sort.SortMethod = xlPinYin .Sort.Apply End With End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) On Error GoTo hell 'Abbruch durch Formelfehler EVALUATE abfangen TextBox6.Text = Evaluate("=VLOOKUP(" & TextBox1.Text & ",'Standorte'!A2:S355,5,0)") CommandButton4.Enabled = True 'Es ist möglich, zu speichern - denn die ID ist gültig GoTo heaven: 'Fehlerbehandlung überspringen, falls kein Fehler vorkam hell: 'Fehlerbehandlung: User aufmerksam machen, Info-Texte in die Textboxen schreiben MsgBox ("Die ID-Nummer " & TextBox1.Text & " gibt es nicht!") TextBox6.Text = "SPEICHERN NICHT MÖGLICH" TextBox1.Text = "ungültig" CommandButton4.Enabled = False 'speichern verhindern durch deaktivieren des Buttons 'bei eingabe einer gültigen ID-Nummer wird der speichern-Button wieder aktiviert heaven: End Sub

Beliebteste Forumthreads (12 Monate)

UserForm - Format übernehmen + Einsortieren

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

UserForm - Format übernehmen + Einsortieren

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread