将数据从..SRT文件导入Excel
将数据从..SRT文件导入Excel
提问于 2022-10-15 10:00:33
我在为一些我认为很容易解决的事情而挣扎.但我还是没做好。
请记住，我不是编程专家。
因此，我为自己构建了一个Excel模板，它将.SRT文件转换为脚本格式。
.Srt文件的结构如下：
NUMBER OF SUBTITLE
TIMECODE IN --> TIMECODE OUT
LINE OF TEXT
(.SRT-File-Structure)
1
00:00:01,369 --> 00:00:04,500
Hello there
2
00:00:05,102 --> 00:00:10,200
I am Manuel
(... and so on)我的问题是，我没有成功地导入数据。我尝试了一种非常简单的方式，我使用了这个VBA代码：
Sub Datei_auswaehlen()
Dim Dateiname As Variant
Dim wbQuelle As Workbook
Dim letzteZeile As Long
'ScreenUpdating und PopUps deaktivieren
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dateiname = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.srt*),*.srt*")
If Dateiname <> False Then
letzteZeile = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
Set wbQuelle = Workbooks.Open(Filename:=Dateiname)
wbQuelle.Worksheets(1).Range("A:A").Copy
ThisWorkbook.Worksheets(1).Range("A:A").PasteSpecial
wbQuelle.Close SaveChanges:=False
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub我希望它将所有内容复制到A列中的Excel中，这样我就可以进一步处理它了。
但由于某些原因，我不知道有些.srt文件看起来完全相同，它们被切成两半，如下所示：
1
00:00:41
Text in Line 1
2
00:00:45
Text in Line 2有人能帮我找到更好的方法吗？
万事如意，
手工操作
回答 1
Stack Overflow用户
回答已采纳
发布于 2022-10-15 12:19:47
请测试下一次更新的代码。它将使用OpenText打开文件，并将其第一列内容粘贴到保留代码的工作簿的活动工作表中(因此，必须将第一列为空，否则代码将覆盖其内容)：
Sub Datei_auswaehlen()
Dim Dateiname As String, wbQuelle As Workbook, letzteZeile As Long, shC As Worksheet
'ScreenUpdating und PopUps deaktivieren
Application.ScreenUpdating = False
Set shC = ActiveSheet 'use here the sheet to copy in
Dateiname = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.srt*),*.srt*")
If Dateiname <> "" Then
Workbooks.OpenText fileName:=Dateiname, origin:=65001, _
startRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True _
, space:=False, Other:=False, FieldInfo:=Array(1, 2)
Set wbQuelle = ActiveWorkbook
letzteZeile = wbQuelle.Worksheets(1).cells(rows.count, 1).End(xlUp).row
With wbQuelle.Worksheets(1).Range("A1:A" & letzteZeile)
shC.Range("A1").Resize(.rows.count, .Columns.count).Value = .Value
End With
shC.Range("A:A").EntireColumn.AutoFit
wbQuelle.Close SaveChanges:=False
End If
Application.ScreenUpdating = True
End Sub请在测试后发送一些反馈信息。如果有些事情不够清楚，请不要犹豫要求澄清。
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/74078474
复制相关文章
相似问题
腾讯云开发者
