0

我正在使用以下 vba 代码从 1 个 excel 表中的多个 txt 文件（由管道“|”字符分隔）导入数据：

Sub LoopFiles()

'Variable Declaration
Dim sFilePath As String
Dim sFileName As String

'Specify File Path
sFilePath = Application.ActiveWorkbook.Path

'Check for back slash
If Right(sFilePath, 1) <> "\" Then
    sFilePath = sFilePath & "\"
End If
    
sFileName = Dir(sFilePath & "*.txt")


Do While Len(sFileName) > 0
    If Right(sFileName, 3) = UCase("txt") Then
        'Display file name in immediate window
        'Debug.Print sFileName
        rNum = LastRowColumn(Application.ActiveSheet)
        Call ImportPipeDelimited(sFilePath, sFileName, rNum + 1)
    End If
    'Set the fileName to the next available file
    sFileName = Dir
Loop

End Sub

Sub ImportPipeDelimited(filePath As String, fileName As String, rowNum)
  With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & filePath & fileName, Destination:=Range("A" & rowNum))
    .TextFileParseType = xlDelimited
    .TextFileOtherDelimiter = "|"
    .TextFileColumnDataTypes = Array(1, 9, 9, 1, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9)
    .Refresh BackgroundQuery:=False
  End With

 Dim ws As Worksheet: Set ws = Application.ActiveSheet


 Dim qrytblQueryTable As QueryTable
    For Each qrytblQueryTable In ws.QueryTables
        qrytblQueryTable.Delete
    Next qrytblQueryTable
 End Sub

上面的代码正在做它应该做的事情，它从一个文件夹中的 txt 文件中导入所有相关数据。

问题：在每个 txt 文件中都有标题，由用户名、公司名称和部门组成，如下所示：

GLD740---------------------------------ABC PVT LIMITED------------- ---------------------质量控制

上面的破折号实际上不是 txt 文件数据的一部分，我放置这些实际上是为了表示空格，出于某种原因，编辑器不允许这样做。

上面的标题是导入的，每个 txt 文件都在一个 excel 单元格中（这是预期的，因为它没有用任何已知的字符模式分隔），是否有任何解决方案只使用 vba 代码提取部门名称（在右侧）？请注意，部门名称有不同的长度，如生产部门、财务、管理等

非常感谢任何帮助/建议/解决方案。

谢谢你。

4

1 回答 1

0

我认为正确的功能能够做到这一点。结合 InStrRev 你应该得到你想要的。

Sub ReadTextFileExample()
    Dim sFileName As String: sFileName= 'directory where the file is
    Dim strTextLine As String
    Dim iFile As Integer: iFile = FreeFile
    Open sFileName For Input As #iFile
    Line Input #1, strTextLine
    company_name= Right(strTextLine, Len(strTextLine) - InStrRev(strTextLine," 
",, vbTextCompare))
    Close #iFile
End Sub
于 2020-11-02T06:37:58.020 回答