原來如此
謝謝提醒
以下為自己對程式碼的見解
Dim j&, Jm&, k&, TX&, Arr, Sht As Worksheet '宣告所需的變數於工作表中
TX = TextBox1.Text: If TX = 0 Then Exit Sub 'TX是TextBox1的內容,若TextBox1的內容=0的話就跳出程式
Arr = Sheets("工作表1").UsedRange.Value '傳回該工作表中已使用的範圍給Arr陣列
For j = 19 To UBound(Arr) '迴圈中j=19(應該是我第一顆的data是從第19列開始)到傳回Arr中所指定維度的最高可用註標-------不懂
If IsError(Arr(j, 2)) Then GoTo 101 '若陣列中有產生任何一種錯誤值則跳到101,2:應該是指第2欄,然後
If Arr(j, 2) <> "PASS" Then GoTo 101 '若陣列中包含PASS的話就繼續下面,否則就跳到101
Jm = Jm + 1 '應該是列的初始値
For k = 1 To UBound(Arr, 2): Arr(Jm + 18, k) = Arr(j, k): Next '迴圈中不知道K是什麼,到傳回該工作表中已使用的範圍給Arr與第2欄:Arr(列的初始値+18=19,1)=Arr(第19列,1):next---------極度不懂
If Jm = TX Then Exit For '當Jm=TextBox1所的key的內容時,跳出迴圈
101: Next j '101到If Arr(j, 2) <> "PASS" Then GoTo 101,使其判斷是否符合PASS
If Jm = 0 Then Exit Sub '當Jm=0後跳出程式
以下這段只看的懂新增PASS名單的工作表
On Error Resume Next: Set Sht = Sheets("PASS名單"): On Error GoTo 0
If Sht Is Nothing Then Set Sht = Sheets.Add: Sht.Name = "PASS名單"
With Sht
.Select: .UsedRange.Clear: .[A1].Resize(Jm + 18, UBound(Arr, 2)) = Arr
End With
Dim j&, Jm&, k&, Km&, TX&, Arr, Brr, TT$, Sht As Worksheet
TX = TextBox1.Text: If TX = 0 Then Exit Sub 'TX為TextBox1內所輸入的値,若為0則跳出程式
With Sheets("工作表1").UsedRange '傳回工作表1正在使用的範圍
Arr = .Value 'Arr初始値為1 to 65535,1 to 17-----應該是範圍中的列與欄
Brr = .Rows(12) 'Brr的初始値為1 to 1,1 to17------應該是Range(A12:Q12),因為所要保留的字串是從列12開始到有資料的最後一欄
End With
TT = "_FL_C0_C0/C1_RLD2_RR_TS_C1_FDLD_DLD2_" 'TT應該是我要保留的字串
For j = 3 To UBound(Brr, 2) '依 Brr 的列數用迴圈將資料放入陣列,而j應該是第三欄
If InStr(TT, "_" & Brr(1, j) & "_") = 0 Then Brr(1, j) = "" 'InStr應該是判斷Brr(第一列,第三欄)內的字串,若符合跳到下一個for迴圈,若不符合字串則跳到跳回if繼續循環判斷-------應該不是這樣吧
Next
For j = 12 To UBound(Arr) '迴圈由j=12列開始到Arr陣列的列數
If j > 18 Then '若j>18欄
If IsError(Arr(j, 2)) Then GoTo 101 '若Arr陣列的第18列第2欄出現錯誤的話則跳到101,而略過下面的程式
If Arr(j, 2) <> "PASS" Then GoTo 101 '若Arr陣列的第18列第2欄不等於PASS的話則跳到101,而略過下面的程式
End If
Jm = Jm + 1: Km = 0 'Jm?,Km?
For k = 1 To UBound(Arr, 2) 'k=1到Arr陣列的欄數
If Brr(1, k) <> "" Then Km = Km + 1: Arr(Jm + 11, Km) = Arr(j, k) '若Brr(1,k)不等於0,則將m=Km+1放入Arr(Jm+11,Km)中,則等於Arr(j,k)-----此時第一次j=12,Jm=1,k=1,Km=1,繼續跑for迴圈,可是還是看不懂各變數的關係
Next
If Jm = TX + 7 Then Exit For '當Jm=TextBox1內所輸入的値+7則跳出整個for迴圈-----為什麼要+7?
101: Next j '101程式區塊會Next j-------不懂
If Jm = 0 Then Exit Sub '若Jm=0則跳出整個程式
On Error Resume Next: Set Sht = Sheets("PASS名單"): On Error GoTo 0 '檢查PASS名單的工作表是否已存在,若不存在則略過此項錯誤,繼續使程式執行並使程式恢復檢測與偵錯功能
If Sht Is Nothing Then Set Sht = Sheets.Add: Sht.Name = "PASS名單" '工作表不存在，則新增一個工作表並重命名為PASS名單
With Sht
.Select: .UsedRange.Clear: .[A1].Resize(Jm + 11, Km) = Arr '選取工作表,清除原有資料,並置內陣列內容-----什麼是置內陣列內容?
End With
Sub vbaAFilter()
Dim j&, Jm&, k&, Km&, TX&, Arr, Brr, N&, uChk&, TT$, Sht As Worksheet
TX = TextBox1.Text: If TX = 0 Then Exit Sub
Arr = Sheets("工作表1").UsedRange.Value
ReDim Brr(1 To UBound(Arr, 2))
TT = "_FL_C0_C0/C1_RLD2_RR_TS_C1_FDLD_DLD2_"
For j = 1 To UBound(Arr)
If Arr(j, 1) = "Crystal" Then '以〔Crystal〕判斷是否為〔標題列〕
For k = 1 To UBound(Arr, 2)
Brr(k) = Arr(j, k) '標題文字納入陣列，不符合者填入空字符
If k > 2 And InStr(TT, "_" & Arr(j, k) & "_") = 0 Then Brr(k) = ""
Next k
uChk = 1: N = j - 1 '標題列上方的〔列數〕
End If
If Arr(j, 1) = 1 Then uChk = 2: N = j - 1: Jm = 0
'＿若Ａ欄為１，則判斷為〔明細〕的開始，Ｎ為上方列數，Jm歸零
If uChk = 0 Then GoTo 101
If uChk = 2 And Arr(j, 2) <> "PASS" Then GoTo 101
Jm = Jm + 1: Km = 0
For k = 1 To UBound(Arr, 2)
If Brr(k) <> "" Then Km = Km + 1: Arr(Jm + N, Km) = Arr(j, k)
Next
If uChk = 2 And Jm = TX Then Exit For
101: Next j
If Jm = 0 Then Exit Sub
On Error Resume Next: Set Sht = Sheets("PASS名單"): On Error GoTo 0
If Sht Is Nothing Then Set Sht = Sheets.Add: Sht.Name = "PASS名單"
With Sht
.Select: .UsedRange.Clear: .[A1].Resize(Jm + N, Km) = Arr
End With
End Sub
版主不好意思
我又有個笨問題了
Private Sub CommandButton1_Click()
fileToOpen = Dir(Application.GetOpenFilename("Excel File(*.xls),*.xls"))
a = Split(fileToOpen, "/")
b = a(UBound(a))
MsgBox Left(b, InStr(b, ".") - 1)
End Sub
以上是我run過確定可以執行的程式碼
Private Sub CommandButton4_Click()
Dim Arr3 As Variant
Private Sub CommandButton4_Click()
Dim nm As String, FileFolder As String
nm = Sheets("DATA").Range("G1").Value
Arr3 = Array("PASS名單", "DATA")
Sheets(Arr3).Copy
FileFolder = Application.GetSaveAsFilename(nm & "-", "(*.xls),*.xls")
Sheets("DATA").Range("G1").Clear
Sheets("PASS名單").Range("G1").Clear
ActiveWorkbook.SaveAs FileFolder
End Sub
