Zelleninhalt auf verschiedene Zellen verteilen

  • #1
K

klexy

Bekanntes Mitglied
Themenersteller
Dabei seit
04.05.2002
Beiträge
802
Reaktionspunkte
0
Ort
Bayern
Ich habe folgende Daten in Excel 97 (Leerzeichen werden durch * dargestellt):

12***********Mayer*/*Opernplatz*12*/*D-12345*Musterstadt
54144512*****Schumacher*/*Ferraristr.*12*/*D-70327*Stuttgart
123456*******Dorfdepp*/*An*den*Weihern*12*A*/*D-70327*Stuttgart
654321*******von*Kartoffelsberg*/*Alte*Parkstr.*12*-*14*/*D-78333*Schlonzheim-Mürpfingen
(Kundennummer, Name, Straße, Hausnummer, PLZ, Ort) - Namen und Adressen sind vielfältig in ihrer Länge und Struktur.

Feste Elemente sind:
- 13 Stellen bis der Name anfängt (egal wie lang die Kundennummer ist)
- Schrägstriche nach Name und vor PLZ.

Die Kundennummer separiere ich mit =GLÄTTEN(LINKS(A1;13)).
Aber wie trenne ich die anderen Elemente voneinander - unabhängig von ihrer Struktur?

Keine Ahnung wonach ich in der Excel-97-Hilfe suchen muß. Welche Funktionen sind das?

Zefix nochamol!  :mad:
 
  • #2
Hallo klexy,

unter Daten->Text in Spalten...

Dort kannst Du Texte, die aus mehreren Begriffen bestehen und durch ein festes Trennzeichen (bei dir / , eintragen unter 'andere') getrennt sind, in mehrere Spalten auftrennen. Eine Vorschau der Aufteilung ist auch vorhanden.

Das passt bei diesem Problem, da du die Kundennummer bereits abgetrennt hast.

Gruß Matjes :)

Brötchen ? ;)
 
  • #3
Höchstens halbes Brötchen. ;)

Die Kundennummer kann ich aus dieser Zelle zwar in eine andere Zelle schreiben, in der Ursprungszelle ist sie aber immer noch vorhanden und wird nach deiner Methode mit in die erste Zelle mit übernommen.
=LINKS(A1;13) heißt ja zeig mir die ersten 13 Zeichen von links. Gibt es auch zeig mir alle *außer* den ersten 13 Zeichen von Links?
Ha! ;D Hab ich grad selber gefunden: =TEIL(A1;14;100) heißt zeig mir die nächsten 100 ab Stelle 14.

Gibt es da nicht eine Funktion für: gehe bis zum ersten / und schreib das in Zelle xy, dann bis zum nächsten / und schreib das in Zelle yz usw. ? Ich meine, sowas schon gesehen zu haben, aber wo? ???
Sonst müsste ich da mit Makro laborieren und das kann ich nicht vernünftig.
 
  • #4
Hi Klexy,

hier ein Makro zum ausprobieren.
Wenn es noch Schwiergkeiten gibt, melde dich.

Gruß Matjes :)

ganzes Brötchen ? ;)



Code: 
Option Explicit

Sub StrAdresseInZellenAufteilen()
'Erwartet wird ein String pro Zelle der Form
'12***********Mayer*/*Opernplatz*12*/*D-12345*Musterstadt
'1-13: Kundennummer, Name, Straße, Hausnummer, PLZ, Ort, * bedeutet Leerzeichen
'Die Selektion enthält nur Zellen dieses Formats
'

Dim strKNr As String
Const cKNrLng = 13
Dim strName As String
Dim strStrasseHNr As String
Dim strStrasse As String
Dim strHNr As String
Dim strPLZ As String
Dim strOrt As String
Dim tmpStr As String
Dim C As Range
Dim pos1 As Integer, x As Integer
Const cMinStrLng = 40 'Mindestlänge eines Strings
Const cTrenner = / 'Trennzeichen
Const cMld_Trenner = Adressstring hat nicht das richtige Format _
       & vbCrLf &  / fehlt

For Each C In Selection
 tmpStr = C.Value
 If Len(tmpStr) >= cMinStrLng Then 'Mindestlänge des Strings

  'Kennummer
  strKNr = Left(tmpStr, cKNrLng)
  tmpStr = Right(tmpStr, Len(tmpStr) - cKNrLng)

  'Name
  pos1 = InStr(1, tmpStr, cTrenner) ' / suchen
  If pos1 > 0 Then
   strName = Left(tmpStr, pos1 - 2)
   tmpStr = Right(tmpStr, Len(tmpStr) - pos1 - 1)

   'Strasse/Hausnummer
   pos1 = InStr(1, tmpStr, cTrenner) ' / suchen
   If pos1 > 0 Then
    strStrasseHNr = Left(tmpStr, pos1 - 2)
    tmpStr = Right(tmpStr, Len(tmpStr) - pos1 - 1)

    'Strasse/Hausnummer trennen
    x = 1
    Do
     If IsNumeric(Mid(strStrasseHNr, x, 1)) Then Exit Do
     x = x + 1
    Loop Until x > Len(strStrasseHNr)
    If x <= Len(strStrasseHNr) Then
     strStrasse = Left(strStrasseHNr, x - 2)
     strHNr = Right(strStrasseHNr, Len(strStrasseHNr) - x + 1)
    Else
     strStrasse = strStrasseHNr
     strHNr =         'keine Hausnummer
    End If
    
    'PLZ und Ort
    pos1 = InStr(1, tmpStr,  ) ' blanc suchen
    If pos1 > 0 Then
     strOrt = Right(tmpStr, Len(tmpStr) - pos1)
     strPLZ = Left(tmpStr, pos1 - 1)
     
     'Werte in Zellen schreiben
     ActiveSheet.Cells(C.Row, C.Column).Value = strKNr
     ActiveSheet.Cells(C.Row, C.Column + 1).Value = strName
     ActiveSheet.Cells(C.Row, C.Column + 2).Value = strStrasse
     ActiveSheet.Cells(C.Row, C.Column + 3).Value = strHNr
     ActiveSheet.Cells(C.Row, C.Column + 4).Value = strPLZ
     ActiveSheet.Cells(C.Row, C.Column + 5).Value = strOrt

     'Zellen formatieren
     ActiveSheet.Cells(C.Row, C.Column).NumberFormat = 000000000000
     For x = 1 To 5
      With ActiveSheet.Cells(C.Row, C.Column + x)
        .NumberFormat = @
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
      End With
     Next
     
    Else
     C.Interior.ColorIndex = 3 'rot
     MsgBox (cMld_Trenner)
    End If
   Else
    C.Interior.ColorIndex = 3 'rot
    MsgBox (cMld_Trenner)
   End If
  Else
   C.Interior.ColorIndex = 3 'rot
   MsgBox (cMld_Trenner)
  End If
 End If
Next

End Sub
 
  • #5
Dreiviertel Brötchen. ;)

Makro funktioniert an und pfirsich. Aber nicht 100%ig wenn ich den Blattschutz auf die Tabelle gelegt habe. Der ist aber nötig weil die Tabelle ein Formular darstellt in dem DAUs rumwerkeln.
Das Ergebnis wird dann zwar korrekt ausgegeben aber es kommt trotzdem folgende Fehlermeldung, die ich den Leuten nicht zumuten kann:

Laufzeitfehler '1004'
Die Number-Format-Eigenschaft des Range-Objekts kann nicht festgelegt werden.

Bei Testen markiert er mir folgendes gelb:
[...]
ActiveSheet.Cells(C.Row, C.Column).NumberFormat = 000000000000
[...]
Liegt wahrscheinlich daran, daß der Menüpunkt Format bei gesperrtem Tabellenblatt nicht verfügbar ist. Aus diesem Grund jedenfalls funktioniert auch ein Makro über den Menüpunkt Daten>Text in Spalten nicht.

Ich habe aber zwischenzeitlich ein wenig herumgehirnt und bin auf folgende elegante Lösung gekommen, die ohne Makro auskommt:

654321 von Kartoffelsberg / Alte Parkstr. 12 - 14 / D-78333 Schlonzheim-Mürpfingen
654321*******von*Kartoffelsberg*/*Alte*Parkstr.*12*-*14*/*D-78333*Schlonzheim-Mürpfingen (Leerzeichen hier durch * dargestellt):

Kundennummer: =GLÄTTEN(LINKS(A1;13))
Name: =GLÄTTEN(TEIL(LINKS(A1;FINDEN(/;A1)-1);14;100))
Adresse: =GLÄTTEN(TEIL(A1; FINDEN(/; A1)+1; (FINDEN(/;A1;FINDEN(/;A1)+1))-(FINDEN(/;A1))-1))
PLZ: =GLÄTTEN(TEIL(RECHTS(A1;LÄNGE(A1)-(FINDEN(/;A1;FINDEN(/;A1)+1))-1);3;5))
Ort: =GLÄTTEN(TEIL(RECHTS(A1;LÄNGE(A1)-(FINDEN(/;A1;FINDEN(/; A1)+1))-1);8;100))

Am Ende dieses Formulars hab ich jetzt einen Makro-Button, der den ganzen Schlonz in eine Tabelle in das nächste Tabellenblatt exportieren soll. Und zwar in die erste freie Zeile. Wo ich nicht weiterkomm: Wie bring ich dem Makro bei, die erste freie Zeile zu suchen (Tasten <Strg+Ende>, <Pos 1>, <eins runter>). Hat irgendwas mit xlFirst zu tun, aber hier ist für mich Endstation der Syntax.
???
 
  • #6
Hi Klexy,

hab den Makro umgeschrieben:

Ergebnisse landen auf dem Folgeblatt (hoffentlich kein Blattschutz :>>) in der ersten freien Zeile, so wie Du es wolltest.

Kundennummer als Zahl mit führenden Nullen
Name als Text
Adresse als Text
PLZ als Text
Ort als Text

!Achtung: erste freie Zeile heißt erste nicht benutzte Zeile !
Excel hat eine Macke: Wenn man etwas in eine Zelle schreibt und wieder löscht ist diese Zelle nicht mehr unbenutzt, obwohl nichts mehr darin steht. Das Erscheinungsbild sind dann mehrere leere Zeilen vor dem Eintrag des Makros.
Behebung: Leere Zeilen löschen



Viel Spaß beim Ausprobieren

Matjes :>>>

Brötchen, Brötchen, Brötchen .... ('o' )

ps: erweiterbar ist der Makro, z.B. vor dem Eintrag auf doppelte Kundennummern prüfen, auf gleiche Namen,Adressen usw.

Makro ist per mail unterwegs

Code: 
Option Explicit

Sub StrAdresseInZellenAufteilen()
'Erwartet wird ein String pro Zelle der Form
'12***********Mayer*/*Opernplatz*12*/*D-12345*Musterstadt
'1-13: Kundennummer, Name, Adresse, PLZ, Ort, * bedeutet Leerzeichen
'Die Selektion enthält nur Zellen dieses Formats
'
'Kundennummer, Name, Adresse, PLZ, Ort werden aus dem String selektiert
'selektierte Werte werden in erste freie Zeile auf dem folgenden Blatt geschreiben


Dim strKNr As String, strName As String, strAdresse As String, strPLZ As String, strOrt As String
Const cKNrLng = 13
Dim tmpStr As String
Dim C As Range 'selektierte Zellen
Dim pos1 As Integer, x As Integer, next_row As Integer
Const cMinStrLng = 40 'Mindestlänge eines Strings
Const cTrenner = / 'Trennzeichen

 For Each C In Selection 'über alle selektierten Zellen
  tmpStr = C.Value
  If Len(tmpStr) >= cMinStrLng Then 'Mindestlänge des Strings
   'Kennummer
   strKNr = Left(tmpStr, cKNrLng) ' Kennummer selektieren
   tmpStr = Right(tmpStr, Len(tmpStr) - cKNrLng) 'Kennummer abschneiden
   'Name
   pos1 = InStr(1, tmpStr, cTrenner) ' Trenner / nach Name suchen
   If pos1 > 0 Then
    strName = Left(tmpStr, pos1 - 2) 'Name selektieren
    tmpStr = Right(tmpStr, Len(tmpStr) - pos1 - 1) ' Namen + ' / ' abschneiden
    'Adresse
    pos1 = InStr(1, tmpStr, cTrenner) 'Trenner / nach Adresse suchen
    If pos1 > 0 Then
     strAdresse = Left(tmpStr, pos1 - 2) 'Adresse selektieren
     tmpStr = Right(tmpStr, Len(tmpStr) - pos1 - 1) ' Adresse + ' / ' abschneiden
     
     'PLZ und Ort (ist der Rest)
     pos1 = InStr(1, tmpStr,  ) ' Leerzeichen nach PLZ suchen
     If pos1 > 0 Then
      strOrt = Right(tmpStr, Len(tmpStr) - pos1) 'Ort selektieren
      strPLZ = Left(tmpStr, pos1 - 1)      'PLZ selektieren
      
      'Werte in erste freie Zeile auf dem folgenden Blatt schreiben
      With Worksheets(ActiveSheet.Index + 1)
       next_row = .Cells.SpecialCells(xlCellTypeLastCell).Row + 1
       .Cells(next_row, 1).Value = strKNr
       .Cells(next_row, 2).Value = strName
       .Cells(next_row, 3).Value = strAdresse
       .Cells(next_row, 4).Value = strPLZ
       .Cells(next_row, 5).Value = strOrt
      End With
 
      'Zellen formatieren
      For x = 1 To 5
       With Worksheets(ActiveSheet.Index + 1).Cells(next_row, x)
         .NumberFormat = @      'Format Text
         .HorizontalAlignment = xlLeft 'horizontale Ausrichtung
         .VerticalAlignment = xlTop  'vertikale Ausrichtung
         .WrapText = True       'Zeilenumbruch
       End With
      Next
      'Kundennummer: Format Zahl mit führenden Nullen, ohne Komma
      Worksheets(ActiveSheet.Index + 1).Cells(next_row, 1).NumberFormat = 000000000000
      
     Else
      MsgBox (Adressstring hat nicht das richtige Format & vbCrLf & _
           ' ' fehlt & vbCrLf & vbCrLf & _
          PLZ Ort & vbCrLf & _
          Zeile:  & C.Row)
     End If
    Else
     MsgBox (Adressstring hat nicht das richtige Format & vbCrLf & _
          / fehlt & vbCrLf & vbCrLf & _
         nach Adresse & vbCrLf & _
         Zeile:  & C.Row)
    End If
   Else
    MsgBox (Adressstring hat nicht das richtige Format & vbCrLf & _
         / fehlt & vbCrLf & vbCrLf & _
        nach Name & vbCrLf & _
        Zeile:  & C.Row)
   End If
  End If
 Next
 
End Sub
 
  • #7
Das sieht aber schwer nach Brot aus. ;D

Das grün geschriebene ist nicht Teil des Makros sondern nur Erklärungstext, stimmt's?
Durch den Rest werd ich mich am Wochenende durchbeißen. Vielleicht versteh ich es ja.

Ziel ist, die Separation per Formel zu machen und den Teil deines Makros, der die Daten ins nächste Tabellenblatt überträgt, in ein eigenes Makro zu implementieren, welches das erste Blatt druckt, überträgt, und löscht. Der nächste Kunde kommt dann wieder an die gleiche Stelle des ersten Blattes, wird gedruckt, übertragen und gelöscht.

...meilenweit bevor ich schlafen kann (wie der Dichter sagt).
 
Thema:

Zelleninhalt auf verschiedene Zellen verteilen

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums

Themen
113.840
Beiträge
707.963
Mitglieder
51.494
Neuestes Mitglied
Flensburg45
Oben