Teilenummern in unterschiedlichen Formaten

Andi Karl · 17.09.2005

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

Matjes · 17.09.2005

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

Andi Karl · 17.09.2005

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!!!!!

Matjes · 17.09.2005

Hallo Andi Karl,

was bedeutet denn

bis zum jeweiligen Ende

?

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

Gruß Matjes

Andi Karl · 17.09.2005

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

Matjes · 17.09.2005

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

Andi Karl · 17.09.2005

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

Matjes · 17.09.2005

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]&amp;   &amp;RC[-4]&amp; &amp;RC[-3]&amp; &amp;RC[-2]&amp; &amp;RC[-1] einfügen
    l_SpaltenOffset = l_SpaltenOffset + 1
    Range(BA2).Offset(0, l_SpaltenOffset).FormulaR1C1 = _
                =RC[-5]&amp;   &amp;RC[-4]&amp; &amp;RC[-3]&amp; &amp;RC[-2]&amp; &amp;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

Matjes · 17.09.2005

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) &amp;     &amp; _
                   Mid(s_Text, 2, 3) &amp;   &amp; _
                   Mid(s_Text, 5, 3) &amp;   &amp; _
                   Mid(s_Text, 8, 2) &amp;   &amp; _
                   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

Andi Karl · 18.09.2005

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

Matjes · 18.09.2005

Hallo Andi,

ich hab die Zeile von

Code:

    l_Zend = Cells(Rows.Count, l_qSp).End(xlUp).Row->letzte Zeile

in

Code:

    l_Zend = Cells(Rows.Count, l_qSp).End(xlUp).Row->letzte Zeile

korrigiert.

Ist in diesem Fall zwar kein Fehler gewesen, da die Spaltenangabe 1 gepasst hat, aber es muß dort die betreffende Spalte angegeben werden.

Gruß Matjes

Andi Karl · 18.09.2005

Hi Matjes,

ich hab jetzt mit deiner Hilfe das Sortieren der Teilenummern (jede einzeln) hinbekommen.

Aber beim Zusammenfügen kommen immer wieder neue Fehlermeldungen.

Hier meine LÖsung:

Sub test()
Dim a As Byte, y, test As String, Inhalt As String, test2 As String
Inhalt = Range(a1).Value
a = Len(Inhalt)

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, 1).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

If a = 11 Then
'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 If

If a = 13 Then
'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) & & _
Mid(s_Text, 12, 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 If

If a = 15 Then
'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) & & _
Mid(s_Text, 12, 4)
'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 If

If a = 17 Then
'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) & & _
Mid(s_Text, 12, 2) & & _
Mid(s_Text, 14, 4)
'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 If

End Sub

Kannst du mir sagen, woran´s liegt?

Danke!!! Andi

Matjes · 18.09.2005

Hallo Andi,

dein Makro ist in der Struktur nicht ganz i.O.

Ist:
For ...
if .. then
next
end if
if .. then
next
...

Soll:
For ...
if then
end if
if then
end if
...
Next

Gruß Matjes

Andi Karl · 18.09.2005

Also, folgendes hab ich schon mal ein-/umgebaut:

Option Explicit
Sub test()
Dim a As Byte, y, test As String, Inhalt As String, test2 As String
Inhalt = Range(a1).Value
a = Len(Inhalt)

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, 1).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

For a = 11 To 17

If a = 11 Then
->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

->Spaltenbreite der Spalte B optimieren
Columns(l_zSp).AutoFit

->Überschrift in B1
With Range(B1)
.Value = Tnr Dru
.Font.Bold = True
End With
End If

If a = 13 Then
->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) & & _
Mid(s_Text, 12, 2)
->in Spalte B zurückschreiben
Cells(x, l_zSp).Value = s_KonvText

->Spaltenbreite der Spalte B optimieren
Columns(l_zSp).AutoFit

->Überschrift in B1
With Range(B1)
.Value = Tnr Dru
.Font.Bold = True
End With
End If

If a = 15 Then
->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) & & _
Mid(s_Text, 12, 4)
->in Spalte B zurückschreiben
Cells(x, l_zSp).Value = s_KonvText

->Spaltenbreite der Spalte B optimieren
Columns(l_zSp).AutoFit

->Überschrift in B1
With Range(B1)
.Value = Tnr Dru
.Font.Bold = True
End With
End If

If a = 17 Then
->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) & & _
Mid(s_Text, 12, 2) & & _
Mid(s_Text, 14, 4)
->in Spalte B zurückschreiben
Cells(x, l_zSp).Value = s_KonvText

->Spaltenbreite der Spalte B optimieren
Columns(l_zSp).AutoFit

->Überschrift in B1
With Range(B1)
.Value = Tnr Dru
.Font.Bold = True
End With
End If
Next
End sub

Allerdings kommt jetzt immer die Fehlermeldung For ohne Next. Ich hab es auch mit Next a probiert, aber das hilft nix.

Bitte sag mir, was ich falsch gemacht habe! Danke

Andi

Andi Karl · 18.09.2005

Vielen Dank für eure Hilfe! Es klappt jetzt. Mein allerallerallererstes eigenes Makro funktioniert!

Danke!

Andi

Andi Karl · 18.09.2005

Hi an alle,

ich dachte, ich hätte jetzt ein funktionierendes Makro, aber da habe ich mich getäuscht.

Hier meine Lösung:

Option Explicit
Sub Tnr_Dru_richtige_Abstände_A()
Dim a As Byte, y, test As String, Inhalt As String, test2 As String
Inhalt = Range(a1).Value
a = Len(Inhalt)

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, 1).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

For a = 11 To 17

If a = 11 Then
->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

->Spaltenbreite der Spalte B optimieren
Columns(l_zSp).AutoFit

->Überschrift in B1
With Range(B1)
.Value = Tnr Dru
.Font.Bold = True
End With
End If

If a = 13 Then
->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) & & _
Mid(s_Text, 12, 2)
->in Spalte B zurückschreiben
Cells(x, l_zSp).Value = s_KonvText

->Spaltenbreite der Spalte B optimieren
Columns(l_zSp).AutoFit

->Überschrift in B1
With Range(B1)
.Value = Tnr Dru
.Font.Bold = True
End With
End If

If a = 15 Then
->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) & & _
Mid(s_Text, 12, 4)
->in Spalte B zurückschreiben
Cells(x, l_zSp).Value = s_KonvText

->Spaltenbreite der Spalte B optimieren
Columns(l_zSp).AutoFit

->Überschrift in B1
With Range(B1)
.Value = Tnr Dru
.Font.Bold = True
End With
End If

If a = 17 Then
->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) & & _
Mid(s_Text, 12, 2) & & _
Mid(s_Text, 14, 4)
->in Spalte B zurückschreiben
Cells(x, l_zSp).Value = s_KonvText

->Spaltenbreite der Spalte B optimieren
Columns(l_zSp).AutoFit

->Überschrift in B1
With Range(B1)
.Value = Tnr Dru
.Font.Bold = True
End With
End If
Next a
Next x

End Sub

Nur leider betrachtet mein Makro nur die letzte Alternative. Das wäre theoretische meistens kein Problem, aber er fügt dann leider am Ende noch Leerzeichen ein, wenn er nix findet.

Und das ist mein Problem, denn z.B. kann ein sverweis die gefundene Nummer nicht mehr erkennen.
Man müsste dann alle Leerzeichen einfügen. Und das wäre sehr umständlich.

Außerdem wird die 3. Alternative nicht richtig erkannt.
A 111 222 33 44 6666 wäre die Lösung.

Aber es wird, da die a=17-Alternative gebraucht wird, folgendes angezeigt: 111 222 33 44 66 66 angezeigt.

Woran liegts? Mal abgesehen davon, dass meine Tabs nicht stimmen.

Danke!

Andi

Thread zusammengefügt

Matjes · 18.09.2005

Hallo Andy,

das For a = 11 To 17 kapier ich nicht, kann nur ahnen, dass du da die Länge meinst. Ein Kommentar ist an solchen Stellen Gold wert

Ich ahne aber wo du hinwillst. Ich hab dir das mal zusammenfassend in ein Makro (mit Kommentar ;D ) geschrieben.

Gruß Matjes

Code:

Option Explicit

Sub AndisErsterMakro()

'*** Konvertierung von Teilenummern
'***
'*** Das Makro erwartet die komprimierten Teilenummern in Spalte A
'*** Es legt eine neue Spalte B an und konvertiert die
'*** folgende Formate nach Spalte B, sonst #FEHLER KONVERTIERUNG
'*** A1112223344          -> A   111 222 33 44
'*** A111222334455        -> A   111 222 33 44 55
'*** A11122233446666      -> A   111 222 33 44    6666
'*** A1112223344556666    -> A   111 222 33 44 55 6666

 ->*** Defintionen ***
 ->Quelle
  Const c_QUELLSPALTE = 1->Spalte A
  Const c_QUELLERSTEZEILE = 2->Startzeile
 ->Ziel
  Const c_ZIELSPALTE = 2->Spalte B

  Dim s_Text As String, x As Long
  Dim l_zSp As Long, l_qSp As Long, l_Zanf As Long, l_Zend As Long
  
 ->Ziel-Spalte einfügen
  l_zSp = c_ZIELSPALTE
  Columns(l_zSp).Insert Shift:=xlToRight
  
 ->zu konvertierender Bereich
  l_qSp = c_QUELLSPALTE->Spalte
  l_Zanf = c_QUELLERSTEZEILE->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 und in Spalte B zurückschreiben
    Cells(x, l_zSp).Value = KonvertierungTeileNummerDurchfuehren(s_Text)
  Next
  
  With Columns(l_zSp)->Spalte B
    .NumberFormat = @->Spalte als Text formatieren
   ->Schrift mit fester Zeichen-Breite,
   ->damit die Leerzeichen als ganzes Zeichen abgebildet werden
    .Font.Name = Courier New
    .AutoFit->Spaltenbreite optimieren
  End With
  
 ->Überschrift in B1
  With Range(B1): .Value = Tnr Dru: .Font.Bold = True: End With
  
 ->erste zu konvertierende Zelle selektieren
  Cells(l_Zanf, l_qSp).Select
  
End Sub
'************************************************************************************
Private Function KonvertierungTeileNummerDurchfuehren(s_KonvText As String) As String
  
 ->konvertiert folgende Formate, sonst #FEHLER KONVERTIERUNG
 ->A1112223344          -> A   111 222 33 44
 ->A111222334455        -> A   111 222 33 44 55
 ->A11122233446666      -> A   111 222 33 44    6666
 ->A1112223344556666    -> A   111 222 33 44 55 6666
  
  Dim s_Teil1 As String, s_Rest As String, s_Teil2 As String, l_lenRest As Long
  
 ->Fehlerkennung setzen
  KonvertierungTeileNummerDurchfuehren = #FEHLER KONVERTIERUNG
  
 ->Mindestlänge prüfen
  If Len(s_KonvText) &lt; 11 Then Exit Function
  
 ->Teil 1 mit konstanter Umwandlung (A1112223344)
  s_Teil1 = Mid(s_KonvText, 1, 1) &amp; String(3,  ) &amp; _
            Mid(s_KonvText, 2, 3) &amp; String(1,  ) &amp; _
            Mid(s_KonvText, 5, 3) &amp; String(1,  ) &amp; _
            Mid(s_KonvText, 8, 2) &amp; String(1,  ) &amp; _
            Mid(s_KonvText, 10, 2)
  
 ->Teil 2 mit variablem Aufbau analysieren
 ->55 oder 6666 oder 556666
  s_Rest = Right(s_KonvText, Len(s_KonvText) - 11)
  l_lenRest = Len(s_Rest)
 ->Fallunterscheidung anhand der Länge
  Select Case l_lenRest
    Case 0->kein 55 und 6666
      s_Teil2 = 
    Case 2->nur 55
      s_Teil2 = String(1,  ) &amp; s_Rest
    Case 4->nur 6666
      s_Teil2 = String(4,  ) &amp; s_Rest
    Case 6->55 und 6666
      s_Teil2 = String(1,  ) &amp; Left(s_Rest, 2) &amp; String(1,  ) &amp; Right(s_Rest, 4)
    Case Else->nicht vorgesehen -> Fehler
      Exit Function
  End Select

 ->Rückgabe: konvertierter String
  KonvertierungTeileNummerDurchfuehren = s_Teil1 &amp; s_Teil2
End Function

Teilenummern in unterschiedlichen Formaten

Andi Karl

Matjes

Andi Karl

Matjes

Andi Karl

Matjes

Andi Karl

Matjes

Matjes

Andi Karl

Matjes

Andi Karl

Matjes

Andi Karl

Andi Karl

Andi Karl

Matjes

Teilenummern in unterschiedlichen Formaten

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums