回復 1#stephenlee
請測試看看,謝謝
Sub test()
Dim Arr, Brr(1 To 10000, 1 To 11), Crr(1 To 10000, 1 To 11)
Dim T$, T1$, n%, n1%, i%, j%, sh
T = Year(Date) & "-" & Month(Date)
For x = 4 To Sheets.Count
sh = UCase(Left(Sheets(x).Name, 2))
If InStr(sh, "QC") Then
With Sheets(x)
Arr = .Range("a1").CurrentRegion
For i = 2 To UBound(Arr)
T1 = Arr(i, 11): If Arr(i, 5) = 0 Then Exit For
If T = T1 Then n = n + 1: For j = 1 To 11: Brr(n, j) = Arr(i, j): Next
Next
End With
ElseIf InStr(sh, "CL") Then
With Sheets(x)
Arr = .Range("a1").CurrentRegion
For i = 145 To UBound(Arr)
T1 = Arr(i, 11): If Arr(i, 5) = 0 Then Exit For
If T = T1 Then n1 = n1 + 1: For j = 1 To 11: Crr(n1, j) = Arr(i, j): Next
Next
End With
End If
Next
If n > 0 Then
With Sheets("QC Summary")
.Range("a1").CurrentRegion.Offset(1, 0) = ClearContents
.[a2].Resize(n, 11) = Brr
End With
End If
If n1 > 0 Then
With Sheets("CLS Summary")
.Range("a1").CurrentRegion.Offset(1, 0) = ClearContents
.[a2].Resize(n1, 11) = Crr
End With
End If
End Sub作者: singo1232001 時間: 2022-1-28 14:01
Sub TEST_A1()
Dim Arr, Brr(2), N(2), i&, j%, YM$, SS, S As Worksheet, T$, k%
YM = Format(Date, "yyyy-m")
ReDim Arr(1 To 20000, 1 To 11)
Brr(1) = Arr: Brr(2) = Arr
For Each S In Sheets
T = UCase(S.Name)
k = Switch(T Like "QC#*", 1, T Like "CLS-QC#*", 2, T = T, 0)
If k = 0 Then GoTo s99
Arr = S.Range("a1").CurrentRegion
For i = 2 To UBound(Arr)
If Arr(i, 5) = 0 Then Exit For
If Arr(i, 11) = YM Then
N(k) = N(k) + 1
For j = 1 To UBound(Arr, 2)
Brr(k)(N(k), j) = Arr(i, j)
Next j
End If
Next i
s99: Next
Set SS = Sheets(Array("QC Summary", "CLS Summary"))
For k = 1 To 2
SS(k).UsedRange.Offset(1, 0).EntireRow.Delete
If N(k) > 0 Then SS(k).[a2].Resize(N(k), 11) = Brr(k)
Next k
End Sub作者: stephenlee 時間: 2022-2-4 10:30
本帖最後由 stephenlee 於 2022-2-4 10:34 編輯
Sub TEST_A1()
Dim Arr, Brr(2), N(2), i&, j%, YM$, SS, S As Worksheet, T$, k%
YM = Format(Date, "yy ...
准提部林 發表於 2022-1-30 08:59
Option Explicit
Sub TEST_A1()
Dim Brr(2), N(2), i&, Arr, SS, S As Worksheet, T$, YM$, k%, j%
'↑宣告變數:Brr是一維陣列Brr(0)~Brr(2),N是一維陣列N(0)~N(2),
'(Arr,SS)是通用型變數,i是長整數,S是工作表變數,(T,YM)是字串變數,
'(k,j)是短整數
YM = Format("2022/1/22", "yyyy-m")
'↑令YM這字串變數是 (日期轉為4碼年分連接"-",再連接月份)的字串
ReDim Arr(1 To 20000, 1 To 11)
'↑宣告Arr這二維陣列範圍:縱向從1到20000列號,橫向從1到11欄號
Brr(1) = Arr
'↑令索引號1的Brr陣列值是 Arr二維陣列
Brr(2) = Arr
'↑令索引號2的Brr陣列值是 Arr二維陣列
For Each S In Sheets
'↑設Each迴圈,令S是迴圈工作表
T = UCase(S.Name)
'↑令T這字串變數是 S迴圈工作表名經字元轉大寫的新字串
k = Switch(T Like "QC#*", 1, T Like "CLS-QC#*", 2, T = T, 0)
'↑令k這短整數是 Switch 函數回傳的值,規則如下:
'如果 T字串變數是 "QC"開頭,連接至少帶有1碼數字的規則,就回傳數字 1 給k變數
'如果 T字串變數是 "CLS-QC"開頭,連接至少帶有1碼數字的規則,就回傳數字 2 給k變數
'如果 T字串變數是 自身等式,就回傳數字 0 給k變數
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/switch-function
If k = 0 Then GoTo s99
'↑如果k變數是 0,就跳到 s99位置繼續執行
Arr = S.Range("a1").CurrentRegion
'↑令Arr這二維陣列! 倒入 S迴圈工作表[A1]相鄰儲存格串並後擴展成的最小方正範圍儲存格集值
For i = 2 To UBound(Arr)
'↑設順迴圈!i從2到Arr陣列縱向最大索引列號數
If Arr(i, 5) = 0 Then Exit For
'↑如果i迴圈列5欄Arr陣列值是 0,就跳出i層For圈繼續執行
If Arr(i, 11) = YM Then
'↑如果i迴圈列11欄Arr陣列值是 YM字串變數?
N(k) = N(k) + 1
'↑令k變數索引號的N陣列值是 自身累加 1
For j = 1 To UBound(Arr, 2)
'↑設順迴圈!j從1到Arr陣列橫向最大索引欄號數
Brr(k)(N(k), j) = Arr(i, j)
'↑令k變數索引號Brr陣列值(二維陣列)中 ,
'(k變數索引號的N陣列值 列號,j迴圈欄號),
'第一次認識這樣的陣列,這不知道是不是所謂的三維陣列??謝謝
'這三維陣列值是 i迴圈列j迴圈欄Arr陣列值
Next j
End If
Next i
s99: Next
Set SS = Sheets(Array("QC Summary", "CLS Summary"))
'↑令SS這通用型變數是工作表集
For k = 1 To 2
'↑設順迴圈!k從1到2
SS(k).UsedRange.Offset(1, 0).EntireRow.Delete
'↑令SS變數工作表集k索引號工作表,使用的儲存格擴展最小方正儲存格集,
'向下偏移一列的儲存格集範圍列刪除
If N(k) > 0 Then SS(k).[a2].Resize(N(k), 11) = Brr(k)
'↑如果k變數索引號的N陣列值 >0 ,就令SS變數工作表集k索引號工作表,
'[a2]擴展向下 k變數索引號的N陣列值列,向右擴展11欄,這範圍儲存格,
'以Brr三維陣列的第k索引號層陣列帶入,謝謝
Next k
End Sub