DVD-Liste automatisch sortieren lassen

Dieses Thema DVD-Liste automatisch sortieren lassen im Forum "Microsoft Office Suite" wurde erstellt von Jad31, 16. Apr. 2013.

Thema: DVD-Liste automatisch sortieren lassen Hallo erstmals zusammen Ich habe folgendes Anliegen: Habe selber im Excel eine DVD-Liste erstellt, um meine...

  1. Hallo erstmals zusammen

    Ich habe folgendes Anliegen: Habe selber im Excel eine DVD-Liste erstellt, um meine Sammlung auf Papier (oder eben digital :) ) zu haben. Wenn ich nun einen neuen Titel (oder halt mehrere neue Titel) eingebe, möchte ich, dass es automatisch zu diesem Buchstaben springt wo es gehört und auch automatisch eine neue Nummer zugeordnet bekommt. Wie kann ich das machen? Müssen da Makros eingesetzt werden? Oder funktioniert es auch ohne?

    Danke im Voraus für die Antwort.

    Liebe Grüsse aus der Schweiz
    Jad31
     
  2. Ich habe mal ein Makro aufgenommen. Klappt schon sehr gut, aber ein Punkt ist noch nicht geknackt: Ich möchte auch, dass es automatisch eine neue Nummer zugewiesen bekommt. Beispiel: Ich habe einen neuen Film das mi G anfängt. Ich schreibe ihn in einer leeren Zeile die keine Nummer hat. Nun sortiert er mir den Namen und sollte aber auch gleich eine neue Nummer zugewiesen erhalten. Wie mache ich das?
    Hier noch den Code:
    Sub Sortierung_nach_Nummern()
    '
    ' Sortierung_nach_Nummern Makro
    '
    ' Tastenkombination: Strg+s
    '
    Columns(B:B).Select
    ActiveWorkbook.Worksheets(Tabelle2).ListObjects(Tabelle1).Sort.SortFields. _
    Clear
    ActiveWorkbook.Worksheets(Tabelle2).ListObjects(Tabelle1).Sort.SortFields. _
    Add Key:=Range(Tabelle1[[#All],[Film]]), SortOn:=xlSortOnValues, Order _
    :=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(Tabelle2).ListObjects(Tabelle1).Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
    Range(A3:A5).Select
    Selection.AutoFill Destination:=Range(A3:A331), Type:=xlFillDefault
    Range(A3:A331).Select
    End Sub
     
  3. Hallo Jad31,

    kannst Du mal ein Probe-Exemplar deiner Datei zur Verfügung stellen ? Vielleicht mit 3-4 Einträgen.

    Die Angabe der Excel-Version wäre auch von Vorteil ;)

    Die Eingabe im Blatt kann man mit dem Ereignis Worksheet_Change überwachen. Das wird ausgelöst, wenn auf dem Blatt die Eingabe-Taste gedrückt wird. Das Makro müßte dann auf die Spalte(Namen-Spalte) filtern, die das Kriterium für die Einsortierung vorgibt. Wenn also eine Zelle der zu überwachenden Spalte geändert ist, muß das Makro dann zunächst prüfen, ob für diese Zeile bereits eine Nummer vergeben ist. Wenn ja -> nix machen. Wenn nein, stellt es die letzte vergeben Nummer fest, erhöht sie um 1 und trägt sie in die Zeile als neue Nummer ein. Anschließend sortiert das Makro die gesamte Tabelle nach der Namen-Spalte und markiert in der neuen Zeile die Nummer.

    Mit gleichzeitiger Eingabe von mehreren Zeilen wird's komplizierter.

    Gruß Matjes :)
     
  4. Hallo Jad31,

    ich hab mir die Datei mal angeschaut. Das Besondere daran ist, daß du eine vorgefertigte Liste auf einem Excel-Blatt benutzt. Das bedeutet auch für das Makro Besonderheiten.

    Für diese Liste hab ich dir ein Makro geschrieben. (Funktion siehe Kommentare)
    Diesen Code müßtest du in einem Modul speichern.
    Code:
    Sub LfdNrVergeben()
    
     Const c_BLATTNAME = Tabelle2
     Const c_TAB_NAME = Tabelle1
     Const c_TAB_RANGE_NR = Tabelle1[[#All],[Nr.]]
     Const c_TAB_RANGE_FILM = Tabelle1[[#All],[Film]]
     Const c_SP_NR = 1->SpaltenNr für Nr.
     Const c_SP_FILM = 2->SpaltenNr für Film
     
     Dim ws As Worksheet, tb As Object
     Dim zLetzte_Nr As Long, zLetzte_Film As Long, z_tb_letzte As Long, z_tb_header As Long
     Dim lfdNr As Long, z As Long, zStart As Long
     Dim bErr As Boolean
     
    ->Blatt setzen
     Set ws = ThisWorkbook.Worksheets(c_BLATTNAME)
    ->Tabelle setzen
     Set tb = ws.ListObjects(c_TAB_NAME)
    ->Alle Tab-Filter zurücksetzen
     tb.Sort.SortFields.Clear
     
    ->letzte Tabellenzeile feststellen
     z_tb_letzte = tb.Range.Row + tb.ListRows.Count
    ->HeaderzeileNr feststellen
     z_tb_header = tb.HeaderRowRange.Row
     
    ->Tabelle nach Nummer sortieren, sekundär nach Film sortieren, damit ggf Leerzeilen nach unten verschoben werden
     With tb.Sort
      .SortFields.Clear
      .SortFields.Add _
        Key:=Range(c_TAB_RANGE_NR), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
      .SortFields.Add _
        Key:=Range(c_TAB_RANGE_FILM), _
        SortOn:=xlSortOnValues, _
        Order:=xlAscending, _
        DataOption:=xlSortNormal
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .Apply
     End With
      
    ->letzte Zeile in Spalte Film feststellen
     If ws.Cells(z_tb_letzte, c_SP_FILM) <>  Then
      zLetzte_Film = z_tb_letzte
     Else
      zLetzte_Film = ws.Cells(z_tb_letzte, c_SP_FILM).End(xlUp).Row
     End If
    ->prüfen, ob keine Daten in Spalte Film vorhandnen sind. Ggf. Abbruch
     If z_tb_header >= zLetzte_Film Then MsgBox (Spalte -Film- enhält keine Daten): GoTo AUFRAEUMEN
     
    ->letzte Zeile in Spalte Nr. feststellen
     If ws.Cells(z_tb_letzte, c_SP_NR).Value <>  Then
      zLetzte_Nr = z_tb_letzte
     Else
      zLetzte_Nr = ws.Cells(z_tb_letzte, c_SP_NR).End(xlUp).Row
     End If
     
    ->Wenn alle Zeilen in Spalte Film bereits eine Nummer besitzen -> Abbrechen
     If zLetzte_Nr < zLetzte_Film Then
     ->letzte verwendete laufend Nummer feststellen. Bei Fehler erfolgt Meldung und Abbruch.
      If z_tb_header >= zLetzte_Nr Then
       lfdNr = 0
      Else
       On Error Resume Next
       lfdNr = ws.Cells(zLetzte_Nr, c_SP_NR).Value
       If Err.Number <> 0 Then bErr = True
       On Error GoTo 0
       If bErr Then
        ws.Cells(zLetzte_Nr, c_SP_NR).Select
        MsgBox (Fehler: letzte laufende Nr. kann nicht gelesen werden)
        GoTo AUFRAEUMEN
       End If
      End If
      
     ->laufend Nummern eintragen
      zStart = zLetzte_Nr + 1
      For z = zStart To zLetzte_Film
       zLetzte_Nr = zLetzte_Nr + 1
       lfdNr = lfdNr + 1
       ws.Cells(zLetzte_Nr, c_SP_NR).Value = lfdNr
      Next
      
     ->Tabelle nach Film sortieren
      With tb.Sort
       .SortFields.Clear
       .SortFields.Add _
         Key:=Range(c_TAB_RANGE_FILM), _
         SortOn:=xlSortOnValues, _
         Order:=xlAscending, _
         DataOption:=xlSortNormal
       .Header = xlYes
       .MatchCase = False
       .Orientation = xlTopToBottom
       .Apply
      End With
     
     ->letze eingetragene laufende Nummer selektieren
      If ((z_tb_header + 1) <> zLetzte_Nr) Then
       ws.Range(ws.Cells(z_tb_header + 1, c_SP_NR), _
            ws.Cells(zLetzte_Nr, c_SP_NR)).Find(What:=lfdNr, LookAt:=xlWhole).Activate
      Else
       ws.Cells(zLetzte_Nr, c_SP_NR).Select
      End If
     Else
     ->Tabelle nach Film sortieren
      With tb.Sort
       .SortFields.Clear
       .SortFields.Add _
         Key:=Range(c_TAB_RANGE_FILM), _
         SortOn:=xlSortOnValues, _
         Order:=xlAscending, _
         DataOption:=xlSortNormal
       .Header = xlYes
       .MatchCase = False
       .Orientation = xlTopToBottom
       .Apply
      End With
     End If
     
     
    AUFRAEUMEN:
     Set ws = Nothing: Set tb = Nothing
    End Sub
    
    Für den Automatismus, dass dieses Makro automatisch ausgeführt wird, wenn auf Tabelle2 in Spalte B eine Änderung stattfindet, müßtest du das folgende Makro in die Code-Seite des Blattes einfügen.
    Dort gelangst du am einfachsten hin, indem du die Lasche des Blattes markiertst und dannn mit rechte Maustaste->Code anzeigen diese Seite öffnest.
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
    
     Dim objRange As Range
     Set objRange = Intersect(Target, Range(B:B))->Bereich anpassen
     If Not objRange Is Nothing Then
      Call LfdNrVergeben
     End If
     Set objRange = Nothing
    End Sub
    
    Schau mal ob das so passt.

    Gruß Matjes :)
     
  5. Wow, danke vielmals Matjes!!!! :Froehlich2: Die Codes funktionieren super. Nur ein kleines Detail ist mir aufgefallen: Wenn ich ein neuer DVD einfüge, übernimmt es die Nummer die es auf dieser Zeile erhält, verschiebt es aber mit der Nummer zur Position. Beispiel: The Dark Knight erhält die Zahl 13. Nun verschiebt er den Film zu nach den Filmen mit T samt der Nummer (13 The dark Knight, 10 Transporter). Weisst du was ich meine? :)

    Gruss Jad31
     
  6. Hallo Jad31,

    meine Annahme war: wenn ein neuer Filmname eingegeben wird
    - erhält dieser die nächste laufende Nummer, soweit nicht bereits eine Nummer eingetragen ist
    - die Zeile entsprechend dem Filmnamen einsortiert wird

    Was soll denn passieren ? Bitte beschreibe nicht was er falsch macht, sondern das Verhalten, das du erwartest.

    Gruß Matjes :)
     
  7. Hallo Matjes

    Ok, werde es mal erklären, was es genau machen soll. :)
    Wenn ich ein Film hinzufüge,
    - soll die Zeile automatisch entsprechend dem Filmnamen einsortiert werden
    - die Reihenfolge der Nummern soll nochmals neu formatiert werden (da der Film ja keine Nummer hat und irgendwo dazwischen hinzugefügt wird, soll eine neue Nummerierung durchgeführt werden)

    Ich hatte es vorher anders erklärt, aber habe dann beim Ausführen vom Makro gesehen, das es vielleicht auf diese Weise besser funktionieren könnte. :)

    Gruss Jad31
     
  8. Hallo Jad31,

    also prägnanter formuliert:
    bei Änderung und Neueingabe von Filmname,
    - Zeile(n) entsprechend Filmname sortieren
    - Nummerierung der Zeilen mit Filmname neu erstellen

    ?
    Gruß Matjes :)
     
  9. Hallo Matjes

    Du hast es auf den Punkt gebracht, genau! :)

    Gruss Jad31
     
Die Seite wird geladen...

DVD-Liste automatisch sortieren lassen - Ähnliche Themen

Forum Datum
externe Festplatte automatisch aus- und einschalten Windows 10 Forum 1. Dez. 2016
Bilder von Karte automatisch ins Netzwerk kopieren. Womit? Software: Empfehlungen, Gesuche & Problemlösungen 2. Okt. 2016
Windows 10 Computer startet automatisch neu??????warum Windows 10 Forum 16. Sep. 2016
Automatische Updates Windows 10 Forum 11. Aug. 2016
Automatisches Downgrade auf Windows 7 nach Installation von Windows 10 Windows 10 Forum 14. Juli 2016