Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
720to724
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
720to724
720to724
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Aufteilen von Daten innerhalb einer Zelle

Aufteilen von Daten innerhalb einer Zelle
23.01.2006 16:03:10
Daten
Hallo Excel-User!
ich habe ein ganz schwieriges Problem: Ich habe ein Datenbankprogramm
von dem aus ich auf MySQL umsteigen möchte. Ich kann die Datensätze aber
nur in eine Excel-Tabelle Exportieren was ich dann auch gemacht habe.
Nur leider schreibt das Programm die Mitschriebe aus Telefonaten und Sonstige
Notizen in eine einzige Zelle:
Userbild
Bild 1
und

Die Datei https://www.herber.de/bbs/user/30297.jpg wurde aus Datenschutzgründen gelöscht

Bild 2
sodass in einer Zelle dann manchmal bis zu 2 Word-Seiten stehen.
Meine Frage ist nun ob man mithilfe eines VB-Scripts diese einträge wiefolgt
trennen kann: Zwischen den Einzelnen Nozizen sind immer 70 kleine Striche (-)
Siehe Bild.

Die Datei https://www.herber.de/bbs/user/30298.jpg wurde aus Datenschutzgründen gelöscht

Bild 3
Könnte ein VB-Script die Einträge zwischen diesen Strichen Kopieren und in ein neues Blatt jeweils in eine Zelle untereinander mit der Zugehörigen Adressnummer
untereinander einfügen? So etwa:

Die Datei https://www.herber.de/bbs/user/30299.jpg wurde aus Datenschutzgründen gelöscht

Bild 4
Ich hoffe ihr könnt mir helfen!!!
Vielen Dank schon mal im Vorraus
Matthias

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Aufteilen von Daten innerhalb einer Zelle
23.01.2006 16:15:21
Daten
Hallo Matthias,
hast du es schon mit
DATEN - Text in Spalten, dabei das Trennzeichen -
probiert?
Gruß Heinz
AW: Aufteilen von Daten innerhalb einer Zelle
23.01.2006 16:15:55
Daten
Hallo Matthias,
schau mal unter DATEN-TEXT IN SPALTEN, dann ein geeignetes Trennzeichen wählen.
Gruß
Martin Beck
AW: Aufteilen von Daten innerhalb einer Zelle
23.01.2006 16:26:42
Daten
Ja habe ich. Leider kann man da als trennzeichen nur einen Strich einstellen und nicht 70.
Grüße Matthias
AW: Aufteilen von Daten innerhalb einer Zelle
23.01.2006 16:40:31
Daten
Hallo Matthias!
Da gibt's auch die Option "Aufeinanderfolgende Trennzeichen als ein Zzeichen behandeln"
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Aufteilen von Daten innerhalb einer Zelle
23.01.2006 17:20:28
Daten
Leider funktioniert das nicht richtig. Außerdem sind das nacher mehr
als 2000 Datensätze und da jeden manuell zu trennen oder jeden anzuklicken
und mit dieser Excel-Funktion zu trennen wäre zu aufwendig.
Gruß Matthias
AW: Aufteilen von Daten innerhalb einer Zelle
23.01.2006 17:24:54
Daten
Hallo Matthias!
Du kannst die ganze Spalte markieren und "Text in Spalten" ausführen!
Die andere Möglichkeit wäre per VBA, aber dazu müsste man eine Beispieltabelle
mit den korrekten Daten haben, also genau so wie sie nach dem Import in
den Zellen stehen!
'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige
AW: Aufteilen von Daten innerhalb einer Zelle
25.01.2006 00:43:27
Daten
Hallo Matthias!
Öffne mit Alt+F11 den VBE. Gehe auf "Einfügen" &gt "Modul", und kopiere in das
rechte Fenster den unten stehenden Code.
Im Code must du nur den Namen der Tabelle mit der Importierten Liste anpassen!
In deine Tabelle kannst du eine Schaltfläche einfügen und ihr das makro zuweisen!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub splitReport()
Dim lngRow As Long, lngLast As Long, lngFirst As Long
Dim objSh As Worksheet, objShSplit As Worksheet
Dim strLongText As String, strTmp As String
Dim varTmp As Variant
Dim intIndex As Integer, intCol As Integer

Set objSh = Sheets("Sheet1") ' Tabelle mit der Liste! - Anpassen!

On Error Resume Next

Set objShSplit = Sheets("Report Split")

If objShSplit Is Nothing Then
  
  Set objShSplit = Worksheets.Add(after:=objSh)
  
  With objShSplit
    .Name = "Report Split"
    .Cells(1, 1) = objSh.Cells(1, 1)
    .Cells(1, 2) = objSh.Cells(1, 2)
  End With
  
End If

Err.Clear

On Error GoTo ErrExit

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .DisplayAlerts = False
  .Calculation = xlCalculationManual
  .Cursor = xlWait
End With

With objShSplit
  
  .Rows("2:" & Rows.Count).Clear
  .Range("C1:IV1").Clear
  lngLast = objSh.Cells(Rows.Count, 1).End(xlUp).Row
  lngFirst = 2
  intCol = 1
  
  For lngRow = 2 To lngLast
    
    strLongText = objSh.Cells(lngRow, 1)
    
    strTmp = Replace(Replace(Replace(strLongText, Chr(10), Chr(166)), Chr(13), ""), "-", "")
    
    varTmp = Split(strTmp, Chr(166))
    
    For intIndex = 0 To UBound(varTmp)
      If Trim$(varTmp(intIndex)) <> vbNullString Then
        .Cells(lngFirst, intCol) = varTmp(intIndex)
        .Cells(lngFirst, intCol + 1) = objSh.Cells(lngRow, 2)
        lngFirst = lngFirst + 1
        
        If lngFirst > 65536 Then
          lngFirst = 2
          intCol = intCol + 2
          .Cells(1, intCol) = .Cells(1, 1)
          .Cells(1, intCol + 1) = .Cells(1, 1 + 1)
          .Columns(intCol).ColumnWidth = 50
          .Columns(intCol).WrapText = True
          .Columns(intCol + 1).AutoFit
        End If
        
      End If
    Next
    
    Erase varTmp
    strLongText = vbNullString
    strTmp = vbNullString
    
  Next
  
  .Columns(1).ColumnWidth = 50
  .Columns(1).WrapText = True
  .Columns(2).AutoFit
  .Range("1:1").Font.Bold = True
  
End With

ErrExit:

If Err.Number <> 0 Then
  MsgBox Err.Number & vbLf & Err.Description
  Err.Clear
End If

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
  .Cursor = xlDefault
End With

Set objShSplit = Nothing
Set objSh = Nothing

End Sub


'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Anzeige

319 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige