Excel: Makro zur Erstellung einer Liste

Dieses Thema Excel: Makro zur Erstellung einer Liste im Forum "Microsoft Office Suite" wurde erstellt von saletco, 2. Apr. 2005.

Thema: Excel: Makro zur Erstellung einer Liste HAllo zusammen, bin absolut neu im Umgang mit Excel Makroprogrammierung und lese jetzt seit Stunden und bin von...

  1. HAllo zusammen,

    bin absolut neu im Umgang mit Excel Makroprogrammierung und lese jetzt seit Stunden und bin von Minute zu Minute verwirrter.

    Ich möchte eigentlich nur eine Liste aus einer Tabelle erstellen. Und zwar:

    Tabelle Ergebnisliste

    Spalten:
    Nummer, Name, Ort


    Hier sollen nur dann die Zeilenwerte Nummer, Name und Ort aus der Quelle eingefügt werden, wenn in der Spalte NUMMER (Quelle) 3 Zeichen lang ist und überhaupt ein Wert vorhanden ist.

    Wenn nicht, dann soll die Zeile der Quelle ignoriert werden.


    Tabelle Quelldaten:

    Nummer, Name, Ort

    z.B.
    123 Meier Hamburg
    324 Huber Köln
    Hugo Berlin
    342 Möller Frankfurt




    BITTE BITTE helft mir - ich nehme an, dass das eine einfache Übung ist , aber ich blicks nicht.

    Gruß
    Kai
     
  2. Hallo Saletco,

    wie gewünscht. Wenn Du noch Fragen dazu hast, melde dich.

    Gruß Matjes :)

    Code:
    Sub ErgebnislisteErzeugen()
     ->Erzeugt ein neues Blatt Ergebnisliste
     ->Überträgt auf das neue Blatt die Spalten
     ->Nummer,Name, Ort
     ->wenn in Spalte Nummer eine dreistellige Zahl steht
      
     ->Konstanten
      Const c_NameErg = Ergebnisliste
      Const c_SollLng = 3
      
      Const c_ersteWerteZeile = 2->ggf. anpassen !!!!
      Const c_SPNr = 1   'A
      Const c_SPName = 2->B
      Const c_SPOrt = 3 ->C
      
      
      Dim ws_akt As Worksheet, ws_erg As Worksheet
      Dim l_ZeileZiel As Long, x As Long, l_ZeileMax As Long
      
     ->aktuelles Blatt
      Set ws_akt = ActiveSheet
      
     ->Prüfen, ob Ergebnisblatt schon
      On Error Resume Next
      Set ws_erg = Worksheets(c_NameErg)
      If Err.Number = 0 Then
        MsgBox (Es existiert bereits ein Blatt mitdem Namen  & c_NameErg & _
                vbLf & vbLf & Bitte umbenennen oder löschen.)
        Exit Sub
      Else
        Err.Clear
        
      End If
      On Error GoTo 0
      
     ->Ergebnisblatt neu anlegen
      Worksheets.Add After:=ws_akt
      Set ws_erg = ActiveSheet
      ws_erg.Name = c_NameErg
      
     ->Überschriften auf Ergebnisliste
      l_ZeileZiel = 1
      ws_erg.Cells(l_ZeileZiel, c_SPNr).Value = Nummer
      ws_erg.Cells(l_ZeileZiel, c_SPName).Value = Name
      ws_erg.Cells(l_ZeileZiel, c_SPOrt).Value = Ort
      
     ->Zeile max auf Quellblatt
      l_ZeileMax = ws_akt.Cells(ws_akt.Rows.Count, c_SPNr).End(xlUp).Row
      
     ->Zeilen auf Quelleblatt untersuchen
      For x = c_ersteWerteZeile To l_ZeileMax
       ->Nummer 3 Zeichen ?
        If c_SollLng = Len(ws_akt.Cells(x, c_SPNr).Value) Then
         ->nächste frei Zeile Ziel
          l_ZeileZiel = l_ZeileZiel + 1
         ->Wert übertragen
          ws_erg.Cells(l_ZeileZiel, c_SPNr).Value = ws_akt.Cells(x, c_SPNr).Value
          ws_erg.Cells(l_ZeileZiel, c_SPName).Value = ws_akt.Cells(x, c_SPName).Value
          ws_erg.Cells(l_ZeileZiel, c_SPOrt).Value = ws_akt.Cells(x, c_SPOrt).Value
        End If
      Next
      
     ->Aufraeumen
      Set ws_akt = Nothing: Set ws_erg = Nothing
    End Sub
     
  3. HAllo Matjes,

    vielen Dank - toll... bin absolut begeistert.

    Eine erste Frage habe ich : wenn die Nummern länger als 3 Stellen sind, z.b. 11stellig, dann wäre es gut, wenn das Format der Spalte noch mit definiert werden könnte, da ich ansonsten Ausgaben bekomme wie 1.2345E+10 etc.

    Was müsste ich noch wo einfügen, bitte?

    ... achso: wenn ich excel starte und mein excel-file aufrufe, soll excel automatisch das Makro ausführen. Leider kommt nur die Abfrage, ob Makros aktivieren oder deaktivieren. Klicke ich auf aktivieren, passiert nichts. ich muss dann noch extra das Makro aufrufen. Wo kann ich das einstellen, dass das Makro automatisch ausgeführt wird beim Öffnen des Files?

    Vielen Dank und Grüße
    Kai
     
  4. Hi saletco,

    a) um das beim Öffnen zu automatisieren muß dem Makro auch der Name des Quellblattes bekannt sein. Wie lautet der ?

    b) soll alles als Text formatiert werden ?

    c) Soll eine vorhandene Ergebnis-Liste automatisch gelöscht und dann neu angelegt oder soll die neu Ergebnisliste mit Datum/Uhrzeit hinzugefügt werden ?

    Gruß Matjes :)
     
  5. Hallo Matjes,

    Morgenstund hat Gold im Mund :)

    a) das Quellblatt heißt Rohdaten

    b) da ich mit den Daten nicht rechne, kann gerne alles als Text formatiert werden

    c) Ja, das ist ein guter Punkt. Ich möchte die Ergebnisliste als Basis zur weiteren Verarbeitung nutzen. In einem dritten Tabellenblatt möchte ich eine gelayoutete Seite kreieren. Ich habe eben festgestellt, dass mit jedem Mal, wenn eine neue Ergebnisliste erstellt wird, im dritten Blatt der Bezug weg ist.

    Im Grunde müsste lediglich der Inhalt der Ergebnisliste einfach gelöscht werden (dann ist der Bezug noch da, oder?) und die Daten neu reingeschrieben werden.

    Gruß
    Kai
     
  6. Hallo saletco,

    dann also eine neue Version - du siehst ganz so einfach ist das nicht  ;D

    Diese Prozedur muß in eine Modul stehen:
    1) Excel-Datei öffnen
    2) VB-Ediotr öffnen Alt+F11
    Links siehst Du ein Fenster mit der Überschrift Projekt-VBA-Project.
    In diesem Fenster ist die Arbeitsmappe unter dem Namen VBAProject(Dateiname) zu finden.
    3) VBAProject(Dateiname) selektieren
    3) rechte Maustaste->Modul->Modul einfuegen
    in der Mitte geht das Code-Fenster Dateiname - Modulx(Code) auf
    4) den folgenden Code per copy und Paste in dieses Fenster hineinkopieren
    Code:
    Sub ErgebnislisteErzeugen2()
     ->Erzeugt ein neues Blatt Ergebnisliste
     ->ggf. vorhanden Ergebnisliste wird gelöscht
     ->Überträgt auf das neue Blatt die Spalten
     ->Nummer,Name, Ort
     ->wenn in Spalte Nummer eine dreistellige Zahl steht
     ->die Werte wrden als Text formatiert
      
     ->Konstanten
      Const c_NameErg = Ergebnisliste
      Const c_NameQuelle = Rohdaten
      Const c_SollLng = 3
      
      Const c_ersteWerteZeile = 2->ggf. anpassen
      Const c_SPNr = 1   'A
      Const c_SPName = 2->B
      Const c_SPOrt = 3 ->C
      
      
      Dim ws_quelle As Worksheet, l_QuelleZeileMax As Long, x As Long
      Dim ws_erg As Worksheet, l_ZielZeileMax As Long, l_ZielZeile As Long
      
     ->Prüfen, Quellblatt vorhanen
      On Error Resume Next
      Set ws_quelle = Worksheets(c_NameQuelle)
      If Err.Number <> 0 Then
        Err.Clear
        MsgBox (Quell-Blatt  & c_NameQuelle &  nicht vorhanden :-()
        Exit Sub
      End If
      On Error GoTo 0
     ->Zeile max auf Quellblatt
      l_QuelleZeileMax = ws_quelle.Cells(ws_quelle.Rows.Count, c_SPNr).End(xlUp).Row
      
     ->Prüfen, ob Ergebnisblatt schon
      On Error Resume Next
      Set ws_erg = Worksheets(c_NameErg)
      If Err.Number = 0 Then
       ->Ergebnisblatt schon vorhanden
        l_ZielZeileMax = ws_erg.Cells(ws_erg.Rows.Count, c_SPNr).End(xlUp).Row
       ->Zellinhalte löschen
        For x = c_ersteWerteZeile To l_ZielZeileMax
          ws_erg.Cells(x, c_SPNr).Value = 
          ws_erg.Cells(x, c_SPName).Value = 
          ws_erg.Cells(x, c_SPOrt).Value = 
        Next
      Else
        Err.Clear
       ->Ergebnisblatt neu anlegen
        Worksheets.Add After:=ws_quelle
        Set ws_erg = ActiveSheet
        ws_erg.Name = c_NameErg
       ->Überschriften auf Ergebnisliste
        ws_erg.Cells(1, c_SPNr).Value = Nummer
        ws_erg.Cells(1, c_SPName).Value = Name
        ws_erg.Cells(1, c_SPOrt).Value = Ort
      End If
      On Error GoTo 0
      
     ->Spalten als Text formatieren
      ws_erg.Range(ws_erg.Cells(1, c_SPNr), _
                   ws_erg.Cells(l_QuelleZeileMax, c_SPNr)).NumberFormat = @
      ws_erg.Range(ws_erg.Cells(1, c_SPName), _
                   ws_erg.Cells(l_QuelleZeileMax, c_SPName)).NumberFormat = @
      ws_erg.Range(ws_erg.Cells(1, c_SPOrt), _
                   ws_erg.Cells(l_QuelleZeileMax, c_SPOrt)).NumberFormat = @
      
     ->Zeilen auf Quelleblatt untersuchen
      For x = c_ersteWerteZeile To l_QuelleZeileMax
       ->Nummer 3 Zeichen ?
        If c_SollLng = Len(ws_quelle.Cells(x, c_SPNr).Value) Then
         ->nächste frei Zeile Ziel
          l_ZielZeile = l_ZielZeile + 1
         ->Wert übertragen
          ws_erg.Cells(l_ZielZeile, c_SPNr).Value = ws_quelle.Cells(x, c_SPNr).Value
          ws_erg.Cells(l_ZielZeile, c_SPName).Value = ws_quelle.Cells(x, c_SPName).Value
          ws_erg.Cells(l_ZielZeile, c_SPOrt).Value = ws_quelle.Cells(x, c_SPOrt).Value
        End If
      Next
      
     ->Aufraeumen
      Set ws_quelle = Nothing: Set ws_erg = Nothing
    End Sub
    5) speichern mit Alt+S

    Damit das Ganze auch beim Öffnen der Datei ausgeführt wird:
    1) DieseArbeitsmappe im VBAProject-Fenster doppelklicken
    in der Mitte geht das Code-Fenster Dateiname - DieseArbeitsmappe (Code) auf
    2) den folgenden Code per copy und Paste in dieses Fenster hineinkopieren
    Code:
    Private Sub Workbook_Open()
      Call ErgebnislisteErzeugen2
    End Sub
    3) speichern mit Alt+S
    4) VB-Editor schliessen mit Alt+Q

    Ausprobieren ...

    Gruß Matjes :)
     
  7. Cool ... funktioniert soweit.

    Allerdings wird bei mir bei der Nummer immernoch das 1.2344E+ angezeigt. Markiere ich die Zelle, ist der Inhalt oben richtig.

    Vielleicht wäre es doch besser, das ZAhlenformat mit 0 Dezimalstellen zu verwenden. Was muss ich als Format-Bezeichner eintragen?

    Gibt es auch eine Möglichkeit, dass zuerst die Rohdaten erneut importiert werden BEVOR das Makro automatisch ausgeführt wird?

    Derzeit habe ich beim Import das eingestellt gehabt, dass die Rohdaten beim Öffnen des Files geladen werden. Die Makros scheinen aber Vorrang zu haben.

    Zwischendrin nochmal: vielen Dank für deine Hilfe

    Gruß
    Kai
     
  8. Hi saletco,

    der Makro hat noch ein Bug - rasiert die Überschriftenzeile auf dem Ergebnisblatt weg - ist jetzt korrigiert.

    Nummernformat ist jetzt Zahl ohne Nachkommastellen fur Spalte Nummer.

    Mit einem Trick von Klexy werden die Zellen jetzt nochmal durch sich selbst ersetzt, so daß es jetzt unbedingt mit dem Format klappen müßte.

    Bzgl. der Aktuallisierung der Rohdaten hab ich in den Open-Makro statt der direkten Ausführung  ein zeitverzögertes Ausführen des Makros eingebaut.

    Gruß Matjes :)

    Code:
    Private Sub Workbook_Open()
      Application.OnTime Now + TimeValue(00:00:15), ErgebnislisteErzeugen2
    End Sub
    Code:
    Option Explicit
    Sub ErgebnislisteErzeugen2()
     ->Erzeugt ein neues Blatt Ergebnisliste
     ->ggf. vorhanden Ergebnisliste wird gelöscht
     ->Überträgt auf das neue Blatt die Spalten
     ->Nummer,Name, Ort
     ->wenn in Spalte Nummer eine dreistellige Zahl steht
     ->die Werte wrden als Text formatiert
      
     ->Konstanten
      Const c_NameErg = Ergebnisliste
      Const c_NameQuelle = Rohdaten
      Const c_SollLng = 3
      
      Const c_ersteWerteZeile = 2->ggf. anpassen
      Const c_SPNr = 1   'A
      Const c_SPName = 2->B
      Const c_SPOrt = 3 ->C
      
      
      Dim ws_quelle As Worksheet, l_QuelleZeileMax As Long, x As Long
      Dim ws_erg As Worksheet, l_ZielZeileMax As Long, l_ZielZeile As Long
      
     ->Prüfen, Quellblatt vorhanen
      On Error Resume Next
      Set ws_quelle = Worksheets(c_NameQuelle)
      If Err.Number <> 0 Then
        Err.Clear
        MsgBox (Quell-Blatt  & c_NameQuelle &  nicht vorhanden :-()
        Exit Sub
      End If
      On Error GoTo 0
     ->Zeile max auf Quellblatt
      l_QuelleZeileMax = ws_quelle.Cells(ws_quelle.Rows.Count, c_SPNr).End(xlUp).Row
      
     ->Prüfen, ob Ergebnisblatt schon
      On Error Resume Next
      Set ws_erg = Worksheets(c_NameErg)
      If Err.Number = 0 Then
       ->Ergebnisblatt schon vorhanden
        l_ZielZeileMax = ws_erg.Cells(ws_erg.Rows.Count, c_SPNr).End(xlUp).Row
       ->Zellinhalte löschen
        For x = c_ersteWerteZeile To l_ZielZeileMax
          ws_erg.Cells(x, c_SPNr).Value = 
          ws_erg.Cells(x, c_SPName).Value = 
          ws_erg.Cells(x, c_SPOrt).Value = 
        Next
      Else
        Err.Clear
       ->Ergebnisblatt neu anlegen
        Worksheets.Add After:=ws_quelle
        Set ws_erg = ActiveSheet
        ws_erg.Name = c_NameErg
       ->Überschriften auf Ergebnisliste
        ws_erg.Cells(1, c_SPNr).Value = Nummer
        ws_erg.Cells(1, c_SPName).Value = Name
        ws_erg.Cells(1, c_SPOrt).Value = Ort
      End If
      On Error GoTo 0
      
     ->Spalten als Text formatieren
      ws_erg.Range(ws_erg.Cells(1, c_SPNr), _
                   ws_erg.Cells(l_QuelleZeileMax, c_SPNr)).NumberFormat = 0
      ws_erg.Range(ws_erg.Cells(1, c_SPName), _
                   ws_erg.Cells(l_QuelleZeileMax, c_SPName)).NumberFormat = @
      ws_erg.Range(ws_erg.Cells(1, c_SPOrt), _
                   ws_erg.Cells(l_QuelleZeileMax, c_SPOrt)).NumberFormat = @
      
     ->nächste frei Zeile auf Zielblatt
      l_ZielZeile = c_ersteWerteZeile
      
     ->Zeilen auf Quelleblatt untersuchen
      ws_erg.Activate
      For x = c_ersteWerteZeile To l_QuelleZeileMax
       ->Nummer 3 Zeichen ?
        If c_SollLng = Len(ws_quelle.Cells(x, c_SPNr).Value) Then
         ->Wert übertragen
          ws_erg.Cells(l_ZielZeile, c_SPNr).Value = ws_quelle.Cells(x, c_SPNr).Value
          ws_erg.Cells(l_ZielZeile, c_SPNr).Select
         ->klexys Trick :-)
          Selection.Replace What:=Selection.Value, Replacement:=Selection.Value
          ws_erg.Cells(l_ZielZeile, c_SPName).Value = ws_quelle.Cells(x, c_SPName).Value
          ws_erg.Cells(l_ZielZeile, c_SPName).Select
          Selection.Replace What:=Selection.Value, Replacement:=Selection.Value
          ws_erg.Cells(l_ZielZeile, c_SPOrt).Value = ws_quelle.Cells(x, c_SPOrt).Value
          ws_erg.Cells(l_ZielZeile, c_SPOrt).Select
          Selection.Replace What:=Selection.Value, Replacement:=Selection.Value
         ->nächste frei Zeile Ziel
          l_ZielZeile = l_ZielZeile + 1
        End If
      Next
      
     ->Aufraeumen
      Set ws_quelle = Nothing: Set ws_erg = Nothing
    End Sub
     
  9. Danke,

    bei mir gibt es eine Debugg-Meldung bzgl des Select:

    Code:
    ws_erg.Cells(l_ZielZeile, c_SPNr).Select 
    Der Import wird trotzdem erst danach ausgeführt.

    Ist aber nicht so schlimm, Hauptsache ist, dass die Werte verschoben werden und das so funktioniert, wie es dies ja dank deiner Hilfe tut.

    Vielen Dank
    Gruß
    Kai
     
  10. Hi saletco,

    hab die Version oben ein wenig geändert.

    Der Open-Makro ruft den eigentlichen mit der OnTime-Funktion auf - jetzt mit einer Verzögerung von 15 Sekunden. Wenn das nicht ausreicht, bzw. zu lang ist, kannst Du es dort korrigieren.

    Korrektur bzgl. der Debug-Meldung ist auch drin.

    Gruß Matjes  :)
     
Die Seite wird geladen...

Excel: Makro zur Erstellung einer Liste - Ähnliche Themen

Forum Datum
Excel VBA Makro zum suchen eines Textes und anschließend einen Breich zu kopieren Microsoft Office Suite 22. Jan. 2015
Excel VBA Makro zum suchen und markieren von Zeilen die ein bestimmtes Wort enthalten Microsoft Office Suite 16. Juni 2014
Excel: Makro ASCII verschieben Windows XP Forum 8. Nov. 2013
Makros und anderes - Excel Microsoft Office Suite 15. März 2013
Excel Sprungmarke mitten in ein anderes Makro Windows XP Forum 15. März 2012