Question

我正在编写一个宏来将文本文件下载到Excel中，过滤掉不必要的数据并在本地保存修改后的文本文件。

一切正常但是本地写的文件在某些文本周围有引号（“）。我认为这与逗号被视为分隔符有关。可能就是这种情况，如果是这样的话，那就有工作我的代码在下面？

注意：我有一个运行GetHtmlTable和KillLoop程序的按钮。

{{1}}

Answer 1

这里最好的选择是使用VBA将数据写入文本文件，而不是将工作簿保存为文本文件。

考虑以下修改后的代码：

Option Explicit
Public StopLoop As Boolean
Sub GetHtmlTable()
StopLoop = False
Do Until StopLoop = True
    DoEvents
    Dim objWeb As QueryTable

    Sheets(1).Columns(1).ClearContents

    With Sheets("Sheet1")
        Set objWeb = .QueryTables.Add( _
        Connection:="URL;http://www.spotternetwork.org/feeds/gr.txt", _
        Destination:=.Range("A1"))
        With objWeb
            .WebSelectionType = xlSpecifiedTables
            .WebTables = "1" ' Identify your HTML Table here
            .Refresh BackgroundQuery:=False
            .SaveData = True
        End With
    End With
    Set objWeb = Nothing


    'End Import of Text From http://www.spotternetwork.org/feeds/gr.txt==================
    'Start Filter Out Unused Data========================================================
    Dim i As Long
    Dim j As Long
    Dim LRow As Long
    Dim LListRow As Long
    Dim BMatch As Boolean

    'Find last instance of "End:" in
    LRow = Sheets(1).Range("A:A").Find(what:="End*", searchdirection:=xlPrevious).Row
    'Find last non-blank row in column A of second sheet
    LListRow = Sheets(2).Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    If LRow >= 11 Then
        'Make sure there are at least 11 rows of data
        i = LRow
        'MsgBox "First checkpoint: Last row of data is " & LRow 'Comment out this line
        Do
            BMatch = False
            For j = 1 To LListRow
                'Test this block to see if the value from j appears in the second row of data
                If InStr(1, Sheets(1).Range("A" & i - 2).Value2, Sheets(2).Range("A" & j).Value2) > 0 Then
                    BMatch = True
                    Exit For
                End If
            Next j
            'Application.StatusBar = "Match status for row " & i & ": " & BMatch
            If Not BMatch Then
                'Loop backwards to find the starting row (no lower than 11)
                For j = i To 11 Step -1
                    If Sheets(1).Range("A" & j).Value2 Like "Object:*" Then Exit For
                Next j
                Sheets(1).Rows(j & ":" & i).Delete
                i = j - 1
            Else
                'Find next block
                If i > 11 Then
                    For j = i - 1 To 11 Step -1
                        If Sheets(1).Range("A" & j).Value2 Like "End:*" Then Exit For
                    Next j
                    i = j
                Else
                    i = 10 'Force the loop to exit
                End If
            End If
            'Application.StatusBar = "Moving to row " & i
        Loop Until i < 11

        'Loop back through and delete any blank rows
        LRow = Sheets(1).Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row
        'MsgBox "Second checkpoint: new last row of data is " & LRow
        For i = LRow To 11 Step -1
            If Sheets(1).Range("A" & i).Value2 = vbNullString Then Sheets(1).Rows(i).Delete
        Next i
    End If

    'Application.StatusBar = False
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    'End Filter Out Unused Data========================================================
    'Start Write To Local Txt File=====================================================
    Dim sSaveAsFilePath As String
    Application.DisplayAlerts = False


    sSaveAsFilePath = "C:\Users\Speedy\Desktop\Test\test.txt"

    'Delete file if it exists
    On Error Resume Next
    Kill sSaveAsFilePath
    On Error GoTo 0

    'Open file for writing
    LRow = Sheets(1).Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row
    Dim iFile As Integer
    iFile = FreeFile()
    Open sSaveAsFilePath For Output As #iFile
    For i = 1 To LRow
        Print #iFile, Sheets(1).Range("A" & i).Value2
    Next i

    Close #iFile
    Application.DisplayAlerts = True
    Application.Wait (Now + TimeValue("0:00:05")) 'Uncomment this line
Loop
End Sub

Sub KillMacro()
  StopLoop = True ' stop that perpetual loop in Workbook_Open()
  MsgBox "Program Stopped"
End Sub

将Excel工作表保存为制表符分隔的文本文件，而不使用自动双引号分隔符

1 个答案: