Excel Tabellen und VB

Dieses Thema Excel Tabellen und VB im Forum "Microsoft Office Suite" wurde erstellt von MartinSch, 25. Mai 2005.

Thema: Excel Tabellen und VB Hallo zusammen, ich hoffe auch als nicht VBler kann mir geholfen werden. Situation: Datei Preise.txt und Datei...

  1. Hallo zusammen,
    ich hoffe auch als nicht VBler kann mir geholfen werden.

    Situation:

    Datei Preise.txt und Datei Artikelinfo.txt
    Diese beiden sollen in einer Tabelle zusammengefasst werden.
    Das Problem für mich ist der Aufbau der Artikelinfo.txt.

    In der Preise.txt habe ich folgenden Aufbau:
    ArtNr Name Preis EAN ...weiteres (dies ist nur als Denkhilfe und steht nicht in der Datei)
    So steht es in der Datei:
    23456 Artikel1 1200,98 EAN5463 ...weiteres
    24867 Artikel2 2000,00 BCD23145 ...weiteres

    Die Artikelinfo.txt sieht aber so aus:
    ArtNr Text1 Text2 (Denkhilfe!! Nicht in der Datei vorhanden!!)

    23456 CPU: AMD3000+
    23456 RAM: 512MB
    23456 HDD: 40GB
    24867 Name: Test
    24867 HausNr: 564

    In der neuen Tabelle soll es so stehen:

    23456 Artikel1 1200,98 EAN5463 ...weiteres CPU: AMD3000+ RAM:
    512MB HDD: 40GB
    24867 Artikel2 2000,00 BCD23145 ...weiteres Name: Test HausNr: 564

    Also sollen die Text1 u. Text2 eines Artikels aus der Artikelinfo.txt hinter den Angaben des jeweiligen Artikels aus der Preise.txt in einer Zelle zusammengefasst werden.

    Im Original hat eine Artikelinfo.txt ca. 90000 Zeilen! und ein Artikel kann verschiedene Zeilenlängen haben, d.h. Artikel A erstreckt sich über 5 Zeilen und Artikel B erstreckt sich vielleicht über 8 Zeilen.

    Ein Original kann ich nicht verschicken (Datenschutz). Ich hoffe es gut genug beschrieben zu haben?! :-\

    Kann jemand helfen?

    MfG

    Martin
     
  2. Ola,

    warum muss es Excel sein: Beide Tabellen in Access öffnen und über die gemeinsame Nummer verknüpfen ist wesentlich einfacher .... Danch kannst Du eine entrpechende Abfrage erstellen und die dann, wenn nötig wieder nach Excel exportieren ...
     
  3. Klingt gut, aber leider darf/ kann Access nicht genutzt werden.
    :-[
     
  4. Hallo,

    mir fällt im Moment nur ein Makro mit einer Schleife ein das die jeweiligen Zelleninhalte liest, zusammensetzt und neu in die erste Spalte schreibt. Die leere Spalte dann einfach manuell löschen.

    HTH

    Gruß
    Wilfried
     
  5. Das ist im Prinzip einfach, aber recht komplex, weil viele Faktoren mitspielen.

    Fassen wir zum besseren Verständnis zusammen:
    In Preise.txt ist also jeder Artikel nur 1x vorhanden.
    In der Artikelinfo.txt sind zu jedem Artikel unterschiedlich viele Zeilen vorhanden.
    In der neuen Tabelle soll wiederum für jeden Artikel nur eine Zeile vorhanden sein, wobei erst die Daten aus Preise.txt und danach die Daten aus Artikelinfo.txt angezeigt werden sollen.
    Diese Dateien mußt du zuerst in Excel importieren und sie als Preise.xls und Artikelinfo.xls abspeichern

    Da du 90.000 Zeilen, aber kein Access hast, mußt du die Datei Artikelinfo.txt vor dem Import nach Excel halbieren (Excel kann nur 65.000 Zeilen) --> dann hast du 2x 45.000 Zeilen, und die kannst du in Excel verarbeiten. Je nach Leistungsfähigkeit des Rechners kann es allerdings ein wenig dauern.
    Wichtig ist, daß die Artikel jetzt nicht kreuz und quer über Artikelinfo1.txt und Artikelinfi2.txt verteilt sind. Am besten ist es, die Datensätze aufsteigend nach Artikelnummern zu sortieren und erst dann in zwei getrennte Dateien abzuspeichern. Es ist ratsam, zumindest für die Zeit der Bearbeitung, eine Kopfzeile zu erstellen.

    Jetzt muß für jeden Artikel eine einzige Zeile erzeugt werden, in der alle 5 bis 8 Informationen hintereinander statt untereinander stehen. Wir gehen vom oben genannten Beispiel aus: Zeile 1 ist der Tabellenkopf und die Spalten A, B und C sind jeweils belegt.
    - in Zelle D2: =WENN(A2<>A1;x;) --> um die Zeilen zu markieren, die nachher übrigbleiben sollen.
    - in Zelle E2: =WENN(A2<>A1;B2;)
    - in Zelle F2: =WENN(A2<>A1;C2;)
    - in Zelle G2: =WENN(UND(A2<>A1;A2=A3);B3;)
    - in Zelle H2: =WENN(UND(A2<>A1;A2=A3);C3;)
    - in Zelle I2: =WENN(UND(A2<>A1;A2=A4);B4;)
    - in Zelle J2: =WENN(UND(A2<>A1;A2=A4);C4;)
    usw. Du merkst schon, worauf es hinausläuft: Du führst die Formeln soweit nach rechts, wie du maximal Zeilen pro Artikel hast. --> Formeln runterziehen bis ans Ende der Tabelle
    Am Ende filterst du die ganze Tabelle nach Spalte D, wodurch du für jeden Artikel nur eine Einzige Zeile als Resultat bekommst. Das Ganze jetzt natürlich auch für Arikelinfo2.txt. Am Ende hast du dann nur noch soviele Zeilen, daß alle Artikel in ein Excel-Blatt passen. Diese Blatt fügst du als Tabelle2 in die Datei Preise.xls ein

    In Preise.xls sind im o.g Modell die ersten 4 Spalten belegt. Der Übertrag aus Tabelle2 erfolgt also ab Spalte E
    - in Zelle E2: =SVERWEIS(A2;Tabelle2!A:Z;5;FALSCH)
    - in Zelle F2: =SVERWEIS(A2;Tabelle2!A:Z;6;FALSCH)
    - in Zelle G2: =SVERWEIS(A2;Tabelle2!A:Z;7;FALSCH)
    - in Zelle H2: =SVERWEIS(A2;Tabelle2!A:Z;8;FALSCH)
    - in Zelle I2: =SVERWEIS(A2;Tabelle2!A:Z;9;FALSCH)
    - in Zelle J2: =SVERWEIS(A2;Tabelle2!A:Z;10;FALSCH)
    usw. --> Formeln runterziehen

    Am Schluß markierst du das ganze Blatt, Kopierst es und fügst es als Werte ein. Das verkleinert die Datei, weil sie nicht mehr die ganzen Formeln mitschleppen muß und beschleunigt den Umgang damit, weil Excel dazu neigt, immer wieder alles nachzurechnen.

    So. Fertig ist die Laube.
     
  6. Hallo,
    danke erstmal für die Mühe. :eek:

    Folgendes:
    1) Ich bekomme eine Fehlermeldung #NV in allen Zellen des SVERWEIS.
    2) Ich brauche die Daten in nur einer ZELLE. (ZELLE <> ZEILE ;) )
    3) Ich weiss nie wie viele Zeilen ein Artikel belegt (will ja nicht alle Artikel per Hand durchgehen :-X ).

    Ich denke mit Excel VBA muss es irgendwie gehen. Aber ich muss mich erst darauf fit machen. Bevor ich also eine Lösung posten kann vergeht wohl noch eine Weile.
    Bin weiterhin für jeden Vorschlag dankbar!! :D
     
  7. Makro-Prototyp ist per mail unterwegs.

    Gruß Matjes :)
     
  8. Mit dem Makro von Matjes geht es sicher fix und elegant.

    Mit meiner Methode aber auch, wenn auch etwas hausfrauenmäßig.
    zu 1) - Du mußt irgendwo einen Fehler reingebraucht haben. Ich habe heute alles nochmal nach meiner Anleitung gemacht und es geht einwandfrei.
    zu 2) - wenn das so ist, erstellst du hinten noch eine Sumenzelle, die du mit folgender Formel befüllst:
    =E2& &F2&, &G2& &H2&, &I2& &J2&, &K2& &L2 usw. (Bezeichner, Leerzeichen, Wert, Komma, nächster Bezeichner, Leerzeichen, nächster Wert, Komma usw.)
    zu 3) - du mußt nicht wissen, wieviel Zeilen ein Artikel belegt. Du mußt nur die maximal mögliche Anzahl wissen und entsprechen viele Spalten nach rechts mit den Formeln befüllen. Wenn du die Formeln in Artikelinfo.xls runterziehst, dann bleiben die Werte sowieso nur bei der jeweils ersten Zeile eines Artikels stehen, egal wieviele es sind. Das ist dann bei jedem Artikel die Zeile, in der in Spalte D das x steht.

    Wenn du nicht weißt, wieviele Zeilen es maximal pro Artikel gibt, kannst du das mit Hilfe einer Pivot-Abfrage herausfinden: Pivot aufrufen, Artikelnummer ins Feld Zeile ziehen, Artikelnummer ins Feld Daten ziehen, im Feld Daten den Parameter Anzahl auswählen (standardmäßig wird Summe vorgegeben sein), Fertig.

    Wenn du viel mit Artikel- oder Kundenstämmen jonglierst, ist diese Art der Bearbeitung für viele verschiedene Belange leicht anzupassen. Ein Makro anzupassen geht natürlich auch, ist aber viel schwerer zu kapieren (zumindest für mich, obwohl Matjes schon immer sein bestes gibt, seine Makros verständlich zu kommentieren  :) ).
     
  9. :) :)Alles Klar die Scripte laufen jetzt.
    Vielen Dank an alle Mitwirkenden. :D :D
     
  10. Hi zusammen,

    hier das End-Ergebnis der Makro-Version zum mitlesen.

    Gruß Matjes :)
    Code:
    Option Explicit
    'Beschreibung der Quelldatei
    Const c_QUELLDATEINAME As String = artikelinfo.xls
    Const c_QUELLBLATTNAME As String = Tabelle1
    Const c_QUELLE_SP_Nr As Long = 1   'entspricht Spalte A
    Const c_QUELLE_SP_Text As Long = 3->entspricht Spalte C
    Const c_QUELLE_Z_ERSTEWERTEZEILE = 1
    'Beschreibung der Zieldatei
    Const c_ZIELDATEINAME As String = preisliste.xls
    Const c_ZIELBLATTNAME As String = Tabelle1
    Const c_ZIEL_SP_Nr As Long = 1   ->entspricht Spalte A
    Const c_ZIEL_SP_Text As Long = 12->entspricht Spalte L
    Const c_ZIEL_Z_ERSTEWERTEZEILE = 1
    'Formatierung
    Const c_ZIEL_SP_Text_SPALTENBREITE = 255
    
    'Trennzeichen der einzelnen Texte
    Const c_TRENNZEICHEN =   
    '**************************************************************
    Sub ArtikelinfoTexteInPreislisteSpalteJAkkumulieren()
    '****************************************************
    '*** Erwartet werden geöffnete Quell- und Ziel-Dateien
    '***
    '*** Zu jeder Nummer im Ziel-Blatt werden die Zeilen im
    '*** Quellblatt gesucht. Die Text-Spalte der gefundenen
    '*** Zeile wird zu einem Text getrennt durch Trennzeichen
    '*** zusammengefaßt und im Zielblatt in der Spalte der
    '*** entsprechenden Nummer in die Text-Spalte geschrieben
    '***
    '*** Ist in der Quell-Datei keine entsprechende Nummer vorhanden
    '*** wird diese nicht weiter behandelt.
    '***
    '*** in der Quelldaeti fehlerhafte Werte wie #NV, #Name, #Bezug,
    '*** #Wert, usw. werden nicht mit übertragen. Am Ende erfolgt eine
    '*** Report der fehlerhaften Zellen auf einem neu angelegten Blatt
    '*** mit dem Namen FehlerhafteZellen_yyyymmddhhnn
    
    
      Dim wbq As Workbook, wsq As Worksheet, wbz As Workbook, wsz As Worksheet
      Dim b_Fehler As Boolean, f_err() As String, f_err_cnt As Long
      Dim s_Fehlerblatt As String
      
     ->Fehlerspeicher initialisieren
      f_err_cnt = 0: ReDim f_err(1 To 1)
    
     ->Quell-Blatt setzen
      If Not BlattSetzen(wbq, wsq, c_QUELLDATEINAME, c_QUELLBLATTNAME) Then
        GoTo Aufraeumen
      End If
    
     ->Ziel-Blatt setzen
      If Not BlattSetzen(wbz, wsz, c_ZIELDATEINAME, c_ZIELBLATTNAME) Then
        GoTo Aufraeumen
      End If
    
     ->Textspalte des Ziels formatieren
      wsz.Cells(1, c_ZIEL_SP_Text).EntireColumn.ColumnWidth = c_ZIEL_SP_Text_SPALTENBREITE
      wsz.Cells(1, c_ZIEL_SP_Text).EntireColumn.WrapText = True
      
     ->Texte zusammenfassen
      Call TexteZusammenfassen(wsq, wsz, f_err(), f_err_cnt)
      
     ->Fehlerauswertung
      If f_err_cnt = 0 Then
        MsgBox ( _
          Es sind keine fehlerhaften Zellen in  & _
          wbq.Name &  erkannt worden.)
      Else
        s_Fehlerblatt = Fehlerausgabe_Quelldatei(wbq, wsq, f_err(), f_err_cnt)
        MsgBox ( _
          Es sind  & f_err_cnt &  fehlerhaften Zellen in  & _
          wbq.Name &  erkannt worden. & vbLf & _
          Die betreffenden Zellen sind auf dem Blatt  & s_Fehlerblatt &  protokolliert.)
      End If
    
    Aufraeumen:
      Set wbq = Nothing: Set wsq = Nothing: Set wbz = Nothing: Set wsz = Nothing
    End Sub
    '**************************************************************
    Private Function Fehlerausgabe_Quelldatei(wbq As Workbook, wsq As Worksheet, _
                                              f_err() As String, f_err_cnt As Long) As String
     ->Fehlerausgabe der in der Quelldatei als fehlerhaft erkannten Zellen
      
      Dim ws As Worksheet, l_zeile As Long, l_spalte As Long, x As Long
      
     ->neues Blatt einfügen
      Set ws = wbq.Worksheets.Add(After:=wsq)
     -> Name FehlerhafteZellen_yyyymmddhhnn
      ws.Name = FehlerhafteZellen_ & Format(Now, yyyymmdd_hhnn)
      Fehlerausgabe_Quelldatei = ws.Name
      
      l_zeile = 1
      ws.Cells(l_zeile, 1).Value = _
        Protokoll der in  & wbq.Name &  als fehlerhaft erkannten Zellen.
      l_zeile = l_zeile + 2
      
      l_spalte = 0
      For x = 1 To f_err_cnt
        l_spalte = l_spalte + 1
        ws.Hyperlinks.Add _
          Anchor:=ws.Cells(l_zeile, l_spalte), _
          Address:=, _
          SubAddress:=wsq.Name & ! & f_err(x)
        ws.Cells(l_zeile, l_spalte).Value = f_err(x)
        If l_spalte = 10 Then
          l_spalte = 0: l_zeile = l_zeile + 1
        End If
      Next x
      
    End Function
    '**************************************************************
    Private Function TexteZusammenfassen(wsq As Worksheet, wsz As Worksheet, _
                                        f_err() As String, f_err_cnt As Long)
    
      Dim l_qRows As Long, l_zRows As Long, s_zielNr As String
      Dim s_text As String, r As Range, z As Long, s_tmp As String
      Dim Zelle As Range, ersteAdresse As String
      
     ->Fehlerspeicher initialisieren
      f_err_cnt = 0
      ReDim f_err(1 To 1)
      
     ->Zeilenanzahl Quelle feststellen
      l_qRows = wsq.Cells(wsq.Rows.Count, c_QUELLE_SP_Nr).End(xlUp).Row
     ->Zeilenanzahl Ziel feststellen
      l_zRows = wsz.Cells(wsz.Rows.Count, c_ZIEL_SP_Nr).End(xlUp).Row
      
     ->Such-Range der Quelle definieren
      Set r = wsq.Range(wsq.Cells(c_QUELLE_Z_ERSTEWERTEZEILE, c_QUELLE_SP_Nr), _
                        wsq.Cells(l_qRows, c_QUELLE_SP_Nr))
    
    
     ->über alle Nummern der Zieldatei
      For z = c_ZIEL_Z_ERSTEWERTEZEILE To l_zRows
        s_zielNr = wsz.Cells(z, c_ZIEL_SP_Nr).Value
       ->leere übergehen
        If Trim(s_zielNr) <>  Then
         ->Text initialisieren
          s_text = 
         ->wsq.Activate
         ->ersten Eintrag Nummer auf dem Quell-Blatt suchen
          Set Zelle = r.Find(What:=s_zielNr, _
                            After:=wsq.Cells(l_qRows, c_QUELLE_SP_Nr), _
                            LookIn:=xlValues, _
                            Lookat:=xlWhole, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
          If Not Zelle Is Nothing Then
            ersteAdresse = Zelle.Address
            Do
             ->auf fehlerhaften Zellinhalt prüfen
             ->#NV, #Name, #Bezug, #Wert, usw.
              If IsError(wsq.Cells(Zelle.Row, c_QUELLE_SP_Text).Value) Then
               ->Fehlerfeld für Fehlereintrag um 1 vergrößern
                f_err_cnt = f_err_cnt + 1
                ReDim Preserve f_err(1 To f_err_cnt)
               ->Adresse der fehlerhaften Zelle im Fehlerfeld speichern
                f_err(f_err_cnt) = _
                  wsq.Cells(Zelle.Row, c_QUELLE_SP_Text).Address( _
                          RowAbsolute:=False, ColumnAbsolute:=False)
              Else
               ->Text zusammenfassen
                If s_text =  Then
                  s_text = wsq.Cells(Zelle.Row, c_QUELLE_SP_Text).Value
                Else
                s_text = s_text & c_TRENNZEICHEN & _
                          wsq.Cells(Zelle.Row, c_QUELLE_SP_Text).Value
                End If
              End If
             ->nächste Zelle mit Nummer suchen
              Set Zelle = r.FindNext(Zelle)
            Loop While Not Zelle Is Nothing And Zelle.Address <> ersteAdresse
           ->Zusammenfassung in Ziel eintragen
            wsz.Cells(z, c_ZIEL_SP_Text).Value = s_text
          End If
        End If
      Next z
    Aufraeumen:
      Set r = Nothing: Set Zelle = Nothing
    End Function
    '**************************************************************
    Private Function BlattSetzen(wb As Workbook, _
                                ws As Worksheet, _
                                s_DateiName As String, _
                                s_BlattName As String) As Boolean
    
      BlattSetzen = False
      
      On Error Resume Next
      Set wb = Workbooks(s_DateiName)
      If Err.Number <> 0 Then
        MsgBox ( _
          Die Mappe  & s_DateiName &  ist nicht geöffnet. & vbLf & _
          Bitte öffnen Sie die Mappe und starten das Makro erneut.)
        Err.Clear: On Error GoTo 0: Exit Function
      End If
      Set ws = wb.Worksheets(s_BlattName)
      If Err.Number <> 0 Then
        MsgBox ( _
          Das Blatt  & s_BlattName &  in der Mappe  & s_DateiName & _
           kann nicht geöffnet werden. & vbLf & _
          Bitte korrigieren Sie die Mappe und starten das Makro erneut.)
        Err.Clear: On Error GoTo 0: Exit Function
      End If
      
      On Error GoTo 0
      BlattSetzen = True
    End Function
     
Die Seite wird geladen...

Excel Tabellen und VB - Ähnliche Themen

Forum Datum
Excel 2013 SVERWEIS ergibt bei Tabellenübergreifender Nutzung 0 Microsoft Office Suite 16. Sep. 2015
Excel Tabellen erstellen mit mehreren Prüfungen Microsoft Office Suite 28. Juli 2015
Excel - Bestimmte Daten (Zeilen) in ein anderes Tabellenblatt einfügen Windows XP Forum 7. Juli 2012
Excel 2007: Filtern von Tabellen...altes DropDown möglich? Windows XP Forum 16. Feb. 2011
Excel - Werte unterschiedlicher Tabellenblätter für Übersicht automatisch ziehen Microsoft Office Suite 22. Aug. 2010