1
我正在編寫一個宏將文本文件下載到Excel中,篩選出不必要的數據並將修改的文本文件保存在本地。將Excel工作表保存爲不帶自動雙引號分隔符的製表符分隔文本文件
一切正常,但本地編寫的文件引用了某些文本的引號(「),我認爲這與可能被看作分隔符的逗號有關,是這種情況,如果有的話解決下面我的代碼
注:我有一個運行GetHtmlTable和KillLoop程序按鈕這裏
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"
Sheets(1).Copy '//Copy sheet 1 to new workbook
ActiveWorkbook.SaveAs sSaveAsFilePath, xlTextWindows '//Save as text (tab delimited) file
If ActiveWorkbook.Name <> ThisWorkbook.Name Then '//Double sure we don't close this workbook
ActiveWorkbook.Close False
End If
Application.DisplayAlerts = True
Application.Wait (Now + TimeValue("0:00:05"))
Loop
End Sub
Sub KillMacro()
StopLoop = True ' stop that perpetual loop in Workbook_Open()
MsgBox "Program Stopped"
End Sub
這很好用,謝謝! – killrb13
非常好,很樂意幫忙! –