excel - 提取多个文本文件中两个字符之间的数据并重命名它们

Question

我需要一些帮助来创建我的第一个 VBA 代码。

我在一个文件夹中有数千个文本文件，其中包含字符“\”之间的一些数据，这些数据需要提取到 excel 中。

示例文本文件看起来像

值为 1.000000 1.000000 9 0 3 1 1 0 \021-03930\ \021-03930\ \C21XBH113-MD
\C21XBH113-MD2\ \A21XBS\ \A21XBS135\ \A21XBS136\ \W21XBS112\""""数据“包括” 1 1 0 0

我需要将“\”之间的所有信息从多个 txt 文件导出到 excel 的第一列（一个接一个）。

同样，一旦我们在 A 列中获得了此信息，我们需要将它们替换为将在 B 列中输入的其他信息。

enter code here
Sub FindAllPoints()

Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, filedate As String
Dim filenum As Integer
Dim idx%

MyFolder = ThisWorkbook.Path & "\"
MyFile = Dir(MyFolder & "*.txt")
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ListofPoints"
 
  Range("A1").Value = "ListofOLDPoints"
  Range("B1").Value = "ListofNEWPoints"

nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

Do While MyFile <> ""

    Open (MyFolder & MyFile) For Input As #1


    Do Until EOF(1)
        Line Input #1, textline

        idx = InStr(textline, "\")
        If idx > 0 Then
            ActiveSheet.Cells(nextrow, "A").Value = Mid(textline, idx)
            nextrow = nextrow + 1
        End If
        
    Loop
    
    Close #1
    
    MyFile = Dir()

Loop
End Sub

我的代码可能是错误的，请帮助我构建一个可以完成我的任务的代码。

先感谢您。

标签： excelvbaexport

Answer 1

例如：

Sub GetData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet, r As Long
strFolder = GetFolder: If strFolder = "" Then Exit Sub
Dim wdApp As New Word.Application, wdDoc As Word.Document
wdApp.Visible = False: r = 0
Set WkSht = Sheets.Add(After:=Sheets(Sheets.Count))
With WkSht
  .Name = "ListofPoints"
  .Range("A1").Value = "ListofOLDPoints"
  .Range("B1").Value = "ListofNEWPoints"
End With
strFile = Dir(strFolder & "\*.txt", vbNormal)
While strFile <> ""
  r = r + 1
  Set wdDoc = .Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False)
  With wdDoc
    With .Paragraphs.First.Range
      If InStr(.Text, "\") > 0 Then WkSht.Range("A" & r).Value = Split(.Text, "\")(1)
    End With
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub
 
Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function

也就是说，尚不清楚每个文件是否有多个这样的字符串。如果是这样，您可以替换：

Dim WkSht As Worksheet, r As Long

和：

Dim WkSht As Worksheet, r As Long, c as Long

并替换：

      If InStr(.Text, "\") > 0 Then WkSht.Range("A" & r).Value = Split(.Text, "\")(1)

和：

      For c = 1 To UBound(Split(.Text, "\")) - 1
        WkSht.Cells(r, c).Value = Split(.Text, "\")(c)
      Next