麻辣家族討論版版 - Powered by Discuz! Board

Option Explicit
Sub test()
Dim S As Worksheet, f As Integer, r As String, i As Integer, j As Integer, a() As String, t As Date
Dim tmpath As String, MyFile As String
t = Timer
tmpath = ActiveWorkbook.Path
MyFile = tmpath & "\" & "Sch_chk.txt" '讀取當前EXCEL檔案路徑下的指定TXT
i = 1 '從第i列開始寫入檔案資料,i可自訂依自己需要
Set S = ActiveSheet
S.Cells.Clear
f = FreeFile
Open MyFile For Input As #f
Do While Not EOF(f)
Line Input #f, r
If (InStr(1, r, "CHPT Design Note", vbTextCompare)) = 0 And _
(InStr(1, r, "_Index_", vbTextCompare)) = 0 Then '空格_，是一個連接詞，用於換行
a = Split(r, "!") '該檔案以!為分隔符號
S.Cells(i, "a").Resize(, UBound(a) + 1) = a
'For j = 0 To UBound(a)
' s.Cells(i, j + 1).Value = a(j) '讀取資料依序存入第i列的第1個到j個欄位
'Next j
i = i + 1
End If
Loop
Close #f
With S.Range("D1:D" & S.[A1].End(xlDown).Row) 'D1:D"&到A欄最後一列號的範圍
.Cells = "=RC[-2]&RC[-1]"
' 等同自動填滿 : AutoFill Destination:=Range("D1:D" & x &)
.Value = .Value
End With
'ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],RC[-1])"
'ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
' Range("D1").Select
'x = Cells(3, 1).End(xlDown).Row
'Selection.AutoFill Destination:=Range("D1:D" & x & "") '儲存格自動填滿
S.Range("A:A,D:D").Copy
S.Range("H1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Range("A:A,D:D").Select
'Selection.Copy
'Range("H1").Select
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Application.CutCopyMode = False
'*****************************
'2003版沒 RemoveDuplicates 這方法,可用進階篩選不重複的資料
ActiveSheet.Range("$H$1:$I$65536").RemoveDuplicates Columns:=2, Header:=xlNo
'*****************************************
With S.Range("J1:J" & S.[A1].End(xlDown).Row) 'J1:J"&到A欄最後一列號的範圍
.Cells = "=COUNTIF(C[-6],RC[-1])"
' 等同自動填滿 : AutoFill Destination:=Range("J1:J" & x )
.Value = .Value
End With
'y = Cells(9, 1).End(xlDown).Row
'Range("J1").Select
'ActiveCell.FormulaR1C1 = "=COUNTIF(C[-6],RC[-1])"
'Selection.AutoFill Destination:=Range("J1:J" & s.[A1].End(xlDown).Row)
'Selection.AutoFilter
'*****2003 自動篩範圍選,需是連續範圍****************
'ActiveSheet.Range("H:H,J:J").AutoFilter Field:=3, Criteria1:="1"
'**************************************************
S.Range("H1").AutoFilter Field:=3, Criteria1:="1"
'MsgBox "讀取檔案資料ok"
MsgBox Format(Timer - t, "0.0000")
End Sub

複製代碼

S.Range("H1").AutoFilter Field:=3, Criteria1:="1"

複製代碼

'Selection.AutoFilter
62. '*****2003 自動篩範圍選,需是連續範圍****************
63. 'ActiveSheet.Range("H:H,J:J").AutoFilter Field:=3, Criteria1:="1"

複製代碼

AutoFilter 方法 [自動篩選] 篩選出一個清單。為 Variant。
expression.AutoFilter(Field, Criteria1, Operator, Criteria2, VisibleDropDown)
expression 必選。該運算式會傳回 [套用於] 清單中的其中一個物件。
Field 選擇性的 Variant。相對於作為篩選基準欄位 (從清單左側開始，最左側的欄位為第一個欄位) 的位移。

複製代碼