时间戳

首页 > 解决方案 > 读取 txt 文件的 VBA 代码，将指定的单词放入列中

excel - 读取 txt 文件的 VBA 代码，将指定的单词放入列中

问题描述

我正在尝试编写一个 VBA 宏，它将读取文本文档并将特定单词放入列中。更新：这是一个文件样本，显然是 XML，所以至少我今天学到了一些新东西。所以我想我需要一个程序来摆脱 XML 部分，并将文本放入列中。

<Alarm>
<ID>1002</ID>
<Type>Fault</Type>
<Message>Bad Brake</Message>
<Tagname>error.e2</Tagname>
</Alarm>
<Alarm>
<ID>1004</ID>
<Type>Fault</Type>
<Message>No Motion</Message>
<Tagname>error.e4</Tagname>
</Alarm>
<Alarm>
<ID>1005</ID>
<Type>Fault</Type>
<Message>Upper safety door open</Message>
<Tagname>error.e5</Tagname>
</Alarm>

最终，我试图将 4 位错误代码放入 A 列（即 1002、1004...），并将错误消息放入 B 列（即刹车不良，无动作...）。我将粘贴到目前为止的内容，我尝试将其编码为仅开始一对数据。我一直试图将错误消息放入 B 列。错误消息都从每一行的相同位置开始，但我不知道如何停止复制文本，因为每个错误消息的长度不同人物。有任何想法吗？

（PS - 如果代码很糟糕，我很抱歉，我一直在实习电气工程师，所以我的编程已经相当生疏了。）

Private Sub CommandButton1_Click()

Dim myFile As String, textLine As String, ID As Integer, error_msg As Integer

myFile = "C:\Users\scholtmn\Documents\Projects\Borg_Warner_txt_file\BW_fault_codes.txt"

Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textLine
Text = Text & textLine
Loop
Close #1

ID = InStr(Text, "<ID>")
error_msg = InStr(Text, "<Message>")

Range("A1").Value = Mid(Text, ID + 4, 4)
Range("B1").Value = Mid(Text, error_msg + 9, (InStr(Text, " <") - 31))



End Sub

标签： excelvbatext

解决方案

看起来您正在使用的 txt 文件实际上是一个 xml 文件。如果您更改了格式，我从这里稍微调整的这段代码应该可以正常工作。

Sub From_XML_To_XL()
    Dim xmlWb As Workbook, xSWb As Workbook, xStrPath$, xfdial As FileDialog, _
    xFile$, lr%, first As Boolean, r As Range
    first = True
    Set xfdial = Application.FileDialog(msoFileDialogFilePicker)
    xfdial.AllowMultiSelect = False
    xfdial.Title = "Select an XML File"
    If xfdial.Show = -1 Then xStrPath = xfdial.SelectedItems(1) & ""
    If xStrPath = "" Then Exit Sub
    Set xSWb = ThisWorkbook
    lr = xSWb.ActiveSheet.Range("a" & Rows.Count).End(xlUp).Row    ' last used row, column A
    xFile = xStrPath
    Set xmlWb = Workbooks.OpenXML(xFile)
    If first Then
        Set r = xmlWb.Sheets(1).UsedRange                         ' with header
    Else
        xmlWb.Sheets(1).Activate
        Set r = ActiveSheet.UsedRange
        Set r = Range(Cells(3, 1), Cells(r.Rows.Count, r.Columns.Count))
    End If
    r.Copy xSWb.ActiveSheet.Cells(lr + 1, 1)
    lr = xSWb.ActiveSheet.Range("a" & Rows.Count).End(xlUp).Row
    xmlWb.Close False
    first = False
End Sub

如果您利用它是 XML 格式的事实，我认为您会发现这项任务要容易得多。您可以在此处找到有关在 VBA 中使用 XML 的更多信息。

推荐阅读