Sub 複製()
Sheets("超規").Select
Range("A3:V3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("送測").Select
i = Sheets("送測").Columns("A:A").Find("*", LookIn:=xlValues, LOOKAT:=xlWhole, SearchDirection:=xlPrevious).Row + 1
Range("A" & i).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
For j = Sheets("送測").Columns("B:B").Find("*", LookIn:=xlValues, LOOKAT:=xlWhole, SearchDirection:=xlPrevious).Row To 2 Step -1
If Cells(j, 2) <> "複測" Then
Rows(j).Delete
End If
Next
End Sub
Sub TEST()
Dim Arr, i&, N&, j%
'↑宣告變數:Arr是通用型變數,(i,N)長整數,j短整數
With Sheets("超規")
'↑以下是關於 "超規"工作表的程序
Arr = .[A3].Resize(.UsedRange.Rows.Count, 22)
'↑令Arr這通用型變數是二維陣列,以A3儲存格擴展向下整表已使用列數,
'向右22攔的範圍儲存格值帶入此陣列中
End With
For i = 1 To UBound(Arr)
'↑設順迴圈i從1 執行到Arr陣列縱向最大索引列號
If Trim(Arr(i, 2)) = "複測" Then
'↑如果i列欄的Arr陣列值去除頭尾空白字元後 是 "複測"?
N = N + 1
'↑if條件成立就令N這長整數變數累加1
For j = 1 To 22
'↑設順迴圈j從1 執行到 22
Arr(N, j) = Arr(i, j)
'↑令符合條件的該列,其陣列值逐欄覆蓋到Arr陣列N變數列
Next
End If
Next
If N = 0 Then Exit Sub
'↑如果沒有符合條件的情況!就直接結束程序執行
With Sheets("送測")
'↑以下是關於 "送測"工作表的程序
.Cells(Rows.Count, "B").End(3)(2, 0).Resize(N, UBound(Arr, 2)) = Arr
'↑令B欄最後有內容儲存格的下1列/左1格儲存格開始 向下N變數列,
'向右Arr陣列橫向最大索引欄號數 所匡列的儲存格以Arr陣列值寫入
End With
End Sub
發表於 
