Teilenummern in unterschiedlichen Formaten

Dieses Thema Teilenummern in unterschiedlichen Formaten im Forum "Microsoft Office Suite" wurde erstellt von Andi Karl, 17. Sep. 2005.

Thema: Teilenummern in unterschiedlichen Formaten Hi alle! Ich mache grade Praktikum und habe dort viel mit Teilenummern in unterschiedlichen Formaten zu tun. Ich...

  1. Hi alle!

    Ich mache grade Praktikum und habe dort viel mit Teilenummern in unterschiedlichen Formaten zu tun.

    Ich brauche allerdings häufig ein ganz bestimmtes, mit ganz bestimmten Abständen.

    Ein Beispiel:

    Die Nummer A1112223344 soll folgendermaßen erscheinen: A   111 222 33 44
    Zum Beispiel.

    Denn die Nummer kann auch anders aussehen (jeweils im Format, wie es richtig erscheinen soll):

    A111222334455  -> A   111 222 33 44 55
    A11122233446666 -> A   111 222 33 44    6666
    A1112223344556666 -> A   111 222 33 44 55 6666

    Nicht dass jetzt bei euch der falsche Eindruck entsteht: ich wünsche mir NICHT (ehrlich), dass mir jemand ein derartiges Makro schreibt (ich sollte es schließlich mal selbst lernen).

    Aber könnt ihr mir Tipps geben, wie ich das machen könnte? Ich habe bisher meine Makros immer nur aufgezeichnet (und nicht programmiert), also schreibt bitte eure Tipps so, dass auch ich sie verstehe   ;D !

    Vielen Dank für eure Hilfe, euer
    Andi
     
  2. Hallo Andi Karl,

    dann geh doch mal den anderen Weg und beschreibe als Text was im einzelnen passieren soll, wann Fallunterscheidungen getroffen werden müßen usw. Wenn Du diese Logik fertig hast, ist es dann ohne weiteres möglich, dies in Makros zu giessen.
    Wie die einzelnen Befehle heissen oder welche verschiedenen Möglichkeiten es dafür gibt  kann dann gezielt beantwortet werden.

    Als Anfang könnte z.B. dienen:

    1. Der Makro nimmt den Wert der markierten Zelle und speichert ihn in einer Variablen myString
    2. Untersuchung des mystring auf Länge
    2.1 wenn Länge < xxx dann ...
    usw.

    Wenn es am Anfang zu schwer fällt oder zu kompliziert wird, die ganze Lögik zu beschreiben, fängst Du erstmal mit einfachen Fällen an und erweiterst es später.

    Gruß Matjes :)
     
  3. Diesen Algorithmus habe ich erstellt. Jetzt wär´s wahrscheinlich nicht mehr schwer, aber ich weiß nicht genau, wie ich den einfachsten (kürzesten) Fall programmiere. Wie z.B. schaffe ich es, dass Excel von mir eingetragene Formeln bis zum jeweiligen Ende kopiert, nicht nur bis Zeile 88 (wie in dem Beispiel, in dem ich das Makro aufgenommen habe)?

    HILFE!!!!!
     
  4. Hallo Andi Karl,

    was bedeutet denn
    ?

    Kannst Du das etwas genauer beschreiben ? Wodurch wird denn die letzte Zeile festgelegt/bestimmt ?

    Gruß Matjes :)
     
  5. Das jeweilige Ende ist ja eben immer unterschiedlich. Das Makro soll für alle unterschiedlichen Dateien anwendbar sein.

    Und eben alle Teilenummern übersetzen.

    Das können in einer Datei nur 200 Nummern sein, in der anderen aber 20.000.

    Und dieses Problem soll mir das Makro berücksichtigen. Geht das???
    Ich hoffe, ja!!!

    Danke für deine schnelle Antwort!
    Andi
     
  6. Prinzipiell ja,

    in welcher Spalte der jeweils letzten Zeile ist denn immer ein Wert enthalten ?

    Wie sieht denn deine Momentane Formel aus, die nicht bis zum Ende ausfüllt?

    Gruß Matjes :)
     
  7. Also, bisher habe ich mit dem Aufzeichnungstool folgendes geschafft:

    Columns(B:B).Select
    Selection.Insert Shift:=xlToRight
    Range(A2).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range(BA2).Select
    ActiveSheet.Paste
    Range(BB2).Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = =MID(RC[-53],1,1)
    Range(BC2).Select
    ActiveCell.FormulaR1C1 = =MID(RC[-54],2,3)
    Range(BD2).Select
    ActiveCell.FormulaR1C1 = =MID(RC[-55],5,3)
    Range(BE2).Select
    ActiveCell.FormulaR1C1 = =MID(RC[-56],8,2)
    Range(BF2).Select
    ActiveCell.FormulaR1C1 = =MID(RC[-57],10,2)
    Range(BB2).Select
    Selection.AutoFill Destination:=Range(BB2:bb88)
    Range(BB2:BB10000).Select
    Range(BC2).Select
    Selection.AutoFill Destination:=Range(BC2:BC88)
    Range(BC2:BC10000).Select
    Range(BD2).Select
    Selection.AutoFill Destination:=Range(BD2:BD88)
    Range(BD2:BD88).Select
    Range(BE2).Select
    Selection.AutoFill Destination:=Range(BE2:BE88)
    Range(BE2:BE10000).Select
    Range(BF2).Select
    Selection.AutoFill Destination:=Range(BF2:BF88)
    Range(BF2:BF10000).Select
    Range(BG2).Select
    ActiveCell.FormulaR1C1 = _
    =RC[-5]& &RC[-4]& &RC[-3]& &RC[-2]& &RC[-1]
    Range(BG2).Select
    Columns(BG:BG).EntireColumn.AutoFit
    ActiveWindow.SmallScroll ToRight:=2
    Selection.AutoFill Destination:=Range(BG2:BG88)
    Range(BG2:BG88).Select
    Range(BG2).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.End(xlToLeft).Select
    Selection.End(xlToLeft).Select
    Range(B2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    Columns(B:B).EntireColumn.AutoFit
    Range(B1).Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = Tnr Dru
    Range(B2).Select
    End Sub

    Das wandelt jetzt nur die erste Alternative der Teilenummern um. Und beansprucht noch zusätzlich Zellen, die ja vielleicht anderweitig belegt wären (glaube ich zwar nicht, da ich den Speicher-/Berechnungsort bei Spalte BB festgelegt habe).

    Aber es funktioniert zumindest in einfacher Form.

    Wie könnte ich den Befehl jetzt umbauen, um auf die Möglichkeiten angemessen zu reagieren, die ich im letzten Mail angesprochen habe?

    Könntest du mir da noch helfen? Ich versuch dann irgendwie, die anderen wenn-Bedingungen hinzubekommen.

    Vielen Dank!

    Du bist wirklich ein extrem feiner Kerl, Matjes!

    Andi
     
  8. Hallo Andi,

    danke für die Blumen  ::)  ::)  ::)

    Ich hab in deiner Version die aufgezeichneten Befehle zusammengefaßt, die überflüssigen rausgeworfen, Kommentare hinzugefügt und so erweitert, daß alle Zeilen ausgefüllt werden.

    Zusätzlich hab ich am Schluß noch das Löschen der Hilfsspalten eingebaut.

    Gruß Matjes  ;)

    Code:
    Option Explicit
    Sub AndisErsterMakro()
    
        Dim l_AnzZeilen As Long, l_SpaltenOffset As Long
        
       ->vor Spalte B eine Spalte einfügen
        Columns(B:B).Insert Shift:=xlToRight
        
       ->Alle Nummern aus Splate A ab Zelle A2 in Hilfsspalte BA2 kopieren
        Range(Range(A2), Range(A2).End(xlDown)).Copy Destination:=Range(BA2)
        
       ->Anzahl der Zeilen des Bereiches feststellen
        l_AnzZeilen = Range(Range(A2), Range(A2).End(xlDown)).Rows.Count
        
        l_SpaltenOffset = 0
       ->in die nächste Spalte Formel =MID(RC[-53],1,1) einfügen
        l_SpaltenOffset = l_SpaltenOffset + 1
        Range(BA2).Offset(0, l_SpaltenOffset).FormulaR1C1 = =MID(RC[-53],1,1)
        Range(BA2).Offset(0, l_SpaltenOffset).AutoFill _
              Destination:=Range(Range(BA2).Offset(0, l_SpaltenOffset), _
                                 Range(BA2).Offset(l_AnzZeilen - 1, l_SpaltenOffset)), _
              Type:=xlFillDefault
        
       ->in die nächste Spalte Formel =MID(RC[-54],2,3) einfügen
        l_SpaltenOffset = l_SpaltenOffset + 1
        Range(BA2).Offset(0, l_SpaltenOffset).FormulaR1C1 = =MID(RC[-54],2,3)
        Range(BA2).Offset(0, l_SpaltenOffset).AutoFill _
              Destination:=Range(Range(BA2).Offset(0, l_SpaltenOffset), _
                                 Range(BA2).Offset(l_AnzZeilen - 1, l_SpaltenOffset)), _
              Type:=xlFillDefault
        
       ->in die nächste Spalte Formel =MID(RC[-55],5,3) einfügen
        l_SpaltenOffset = l_SpaltenOffset + 1
        Range(BA2).Offset(0, l_SpaltenOffset).FormulaR1C1 = =MID(RC[-55],5,3)
        Range(BA2).Offset(0, l_SpaltenOffset).AutoFill _
              Destination:=Range(Range(BA2).Offset(0, l_SpaltenOffset), _
                                 Range(BA2).Offset(l_AnzZeilen - 1, l_SpaltenOffset)), _
              Type:=xlFillDefault
        
       ->in die nächste Spalte Formel =MID(RC[-56],8,2) einfügen
        l_SpaltenOffset = l_SpaltenOffset + 1
        Range(BA2).Offset(0, l_SpaltenOffset).FormulaR1C1 = =MID(RC[-56],8,2)
        Range(BA2).Offset(0, l_SpaltenOffset).AutoFill _
              Destination:=Range(Range(BA2).Offset(0, l_SpaltenOffset), _
                                 Range(BA2).Offset(l_AnzZeilen - 1, l_SpaltenOffset)), _
              Type:=xlFillDefault
        
       ->in die nächste Spalte Formel =MID(RC[-57],10,2) einfügen
        l_SpaltenOffset = l_SpaltenOffset + 1
        Range(BA2).Offset(0, l_SpaltenOffset).FormulaR1C1 = =MID(RC[-57],10,2)
        Range(BA2).Offset(0, l_SpaltenOffset).AutoFill _
              Destination:=Range(Range(BA2).Offset(0, l_SpaltenOffset), _
                                 Range(BA2).Offset(l_AnzZeilen - 1, l_SpaltenOffset)), _
              Type:=xlFillDefault
        
       ->in die nächste Spalte Formel =RC[-5]&   &RC[-4]& &RC[-3]& &RC[-2]& &RC[-1] einfügen
        l_SpaltenOffset = l_SpaltenOffset + 1
        Range(BA2).Offset(0, l_SpaltenOffset).FormulaR1C1 = _
                    =RC[-5]&   &RC[-4]& &RC[-3]& &RC[-2]& &RC[-1]
        Range(BA2).Offset(0, l_SpaltenOffset).AutoFill _
              Destination:=Range(Range(BA2).Offset(0, l_SpaltenOffset), _
                                 Range(BA2).Offset(l_AnzZeilen - 1, l_SpaltenOffset)), _
              Type:=xlFillDefault
        
       ->Spaltenbreite dieser Spalte optimieren
        Range(BA2).Offset(0, l_SpaltenOffset).EntireColumn.AutoFit
        
       ->Die Werte dieser Spalte kopieren
        Range(Range(BA2).Offset(0, l_SpaltenOffset), _
              Range(BA2).Offset(l_AnzZeilen - 1, l_SpaltenOffset)).Copy
              
              
       ->Diese Werte ab B2 als Wert einfügen
        Range(B2).PasteSpecial Paste:=xlPasteValues
        
       ->Spaltenbreite der Spalte B optimieren
        Columns(B:B).EntireColumn.AutoFit
        
       ->Überschrift in B1
        With Range(B1)
          .Value = Tnr Dru
          .Font.Bold = True
        End With
        
       ->Und jetzt noch die Hilfspalten wieder beseitigen
        Range(Range(BA2).Offset(0, 0), Range(BA2).Offset(1, l_SpaltenOffset)).EntireColumn.Delete
    End Sub
     
  9. Hallo Andi,

    ich hab den aufgezeichneten Ablauf nochmal ohne Hilfsspalten mit einer Schleife programmiert. Dann kannst Du damit weitermachen.

    Gruß Matjes :)
    Code:
    Option Explicit
    Sub AndisErsterMakro2()
    
        Dim l_ZeileAnf As Long, l_ZeileEnd As Long, x As Long
        Dim s_Text As String, s_KonvText As String
        Dim l_zSp As Long, l_qSp As Long, l_Zanf As Long, l_Zend As Long
        
       ->vor Spalte B eine Spalte einfügen
        l_zSp = 2->Zielspalte
        Columns(l_zSp).Insert Shift:=xlToRight
        
       ->zu konvertierender Bereich
        l_qSp = 1->Spalte
        l_Zanf = 2->Startzeile
        l_Zend = Cells(Rows.Count, l_qSp).End(xlUp).Row->letzte Zeile 
            
       ->Schleife über alle Werte in Spalte A
        For x = l_Zanf To l_Zend
          
         ->Text aus Spalte A holen
          s_Text = Cells(x, l_qSp).Value
          
         ->konvertieren
          s_KonvText = Mid(s_Text, 1, 1) &     & _
                       Mid(s_Text, 2, 3) &   & _
                       Mid(s_Text, 5, 3) &   & _
                       Mid(s_Text, 8, 2) &   & _
                       Mid(s_Text, 10, 2)
         ->in Spalte B zurückschreiben
          Cells(x, l_zSp).Value = s_KonvText
        Next
        
       ->Spaltenbreite der Spalte B optimieren
        Columns(l_zSp).AutoFit
        
       ->Überschrift in B1
        With Range(B1)
          .Value = Tnr Dru
          .Font.Bold = True
        End With
        
    End Sub
     
  10. Vielen Dank! Du hast mir unheimlich geholfen! Danke auch dafür, dass du die Erklärungen dazugeschrieben hast. So habe ich doch noch eine Chance, dass ich das irgendwannmal noch lerne!

    In allertiefster Verbundenheit ;D,

    Andi
     
Die Seite wird geladen...

Teilenummern in unterschiedlichen Formaten - Ähnliche Themen

Forum Datum
Startpartition und Programme auf unterschiedlichen Platten Windows 10 Forum 23. Sep. 2016
VirtualBox VHD an zwei unterschiedlichen Rechnern Windows XP Forum 8. Sep. 2013
eMail und Homepage mit gleicher Domain bei unterschiedlichen Providern? Windows XP Forum 20. Jan. 2012
Firefox mit zwei unterschiedlichen Inhalten auf zwei Monitoren starten Windows XP Forum 8. Okt. 2011
Regelung der Programminstallation in unterschiedlichen Benutzerkontentypen Windows XP Forum 30. Jan. 2010