Das Clever-Excel-Forum.de - Treffen
findet vom 15. - 17. September 2017 in Thüringen / Region Großer Inselsberg statt. Hotelbuchung ab sofort möglich.


Untertitel aus Textdateien in gewünschtes Excelformat bringen
#1
Hallo liebe Leute,

ich möchte gerne Textdateien von Untertiteln in ein entsprechendes Excelformat bringen.
Die Untertitel in der Textdatei sind dabei nach folgendem Format aufgebaut:

1. Indexnummer ( normale Zahl)
2. Zeitmarke
3. Untertiteltext, manchmal über verschiednen Zeilen verteilt.

Das Ganze sieht in der Praxis dann so aus:

(Beispiel):

1
00:01:04,942 --> 00:01:07,711
GANGSTER: So there's a
nigger, a kike and a wop

2
00:01:07,712 --> 00:01:11,515
and they get surrounded by
Indians. The chief walks to them.

3
00:01:11,516 --> 00:01:13,283
He says, "Listen,
we're gonna kill you,

Mittels VBA möchte ich, dass die Textdatei in Excel danach so aussieht:
Indexnummer, Zeitmarke und Untertiteltext jeweils in einer Zelle.

1 00:01:04,942 --> 00:01:07,711 GANGSTER: So there's a nigger, a kike and a wop
2 00:01:07,712 --> 00:01:11,515 and they get surrounded by Indians. The chief walks to them.
3 00:01:11,516 --> 00:01:13,283 He says, "Listen, we're gonna kill you,

Mein funktionierender Code sieht dazu wie folgt aus:

Code:
Sub Untertitelumwandlung()

vbBereich = "A1:A" & Cells(Rows.Count, 1).End(xlUp).Row
Range(vbBereich).Select

For Each zelle In Selection
    'Eventuelle Formeln löschen:
    zelle.Replace What:="=- ", Replacement:=" "
    zelle.Replace What:="- ", Replacement:=" "
    zelle.Replace What:="=", Replacement:=" "
    
    If IsNumeric(zelle.Value) And InStr(zelle.Offset(1, 0), "-->") > 0 Then  
    zelle.Value = zelle.Value & "  " & zelle.Offset(1, 0).Value & "  "
    zelle.Offset(1, 0).Value = ""
    End If
Next zelle



vbBereich = "A1:A" & Cells(Rows.Count, 1).End(xlUp).Row
Range(vbBereich).Select

For Each zelle In Selection
  If Not InStr(zelle.Offset(1, 0), "-->") > 0 And InStr(zelle.Offset(0, 0), "-->") > 0 Then
    tmp = zelle.Offset(1, 0).Value
    zelle.Offset(1, 0).Value = zelle.Value & " " & tmp
    zelle.Value = ""
    End If
Next zelle

vbBereich = "A1:A" & Cells(Rows.Count, 1).End(xlUp).Row
Range(vbBereich).SpecialCells(xlCellTypeBlanks).Delete
End Sub

Ich bin sicher, dieser Code kann wesentlich verbessert werden. Danke für eure Hilfe.


Angehängte Dateien
.txt   Untertitel Textdatei.txt (Größe: 101,81 KB / Downloads: 5)
.xls   Untertiteldatei Excel.xls (Größe: 460,5 KB / Downloads: 6)
to top
#2
Hallo Sonja,

z.B. so:

Code:
Sub Untertitel_2()
  Dim lngA As Long, lngZ As Long
  Dim rngA As Range, rngB As Range
  Dim varB As Variant

  Set rngB = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
  
  With rngB
    .Replace What:="=- ", Replacement:=" "
    .Replace What:="- ", Replacement:=" "
    .Replace What:="=", Replacement:=" "
  End With
  
  ReDim varB(1 To rngB.Rows.Count, 1 To 1)
  
  For Each rngA In rngB.SpecialCells(xlCellTypeConstants).Areas
    lngA = lngA + 1
    varB(lngA, 1) = rngA.Cells(1, 1).Value
    For lngZ = 2 To rngA.Rows.Count
      varB(lngA, 1) = varB(lngA, 1) & "  " & rngA.Cells(lngZ, 1).Value
    Next lngZ
  Next rngA
  
  rngB.Value = varB
  rngB.EntireColumn.AutoFit
End Sub

Gruß Uwe
to top


Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
  Excel VBA Textdateien umbenennen xChristianx 8 102 01.12.2016, 14:02
Letzter Beitrag: xChristianx
  Textdateien aus fortlaufenden Unterordnern in Excel importieren xChristianx 6 110 25.11.2016, 10:32
Letzter Beitrag: Gast 123
  Daten aus Liste in bestimmte Form bringen rajuneon 8 170 17.10.2016, 14:02
Letzter Beitrag: snb
  Excel mit Makro in den Vordergrund bringen Tim1711 3 236 12.08.2016, 09:08
Letzter Beitrag: Tim1711
  mehrere JPG's in eine Zelle bringen / keine Grafik ExcelAnfänger7775 5 287 11.08.2016, 07:58
Letzter Beitrag: ExcelAnfänger7775
  Wie zwei unterschiedliche Tabellen aus einer Arbeitsmappe in ein Diegramm bringen? Wurstsalat 2 325 10.06.2016, 08:01
Letzter Beitrag: Rabe
  Zahlenstrings auf Format bringen Nutella 5 490 21.02.2016, 15:49
Letzter Beitrag: RPP63
Wink SVerweis soll Formel mit Bezügen bringen mikeho 4 569 30.10.2015, 10:28
Letzter Beitrag: mikeho
  externe Excel-Liste in "eigenes Format" bringen ?? haserclaudia 4 702 09.10.2015, 13:59
Letzter Beitrag: haserclaudia
  Textdateien manipulieren Wulfi 3 428 20.09.2015, 16:25
Letzter Beitrag: Wulfi

Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste