返回列表 上一主題 發帖

[發問] Excel 篩選後複製。

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

TOP

回復 5# stephenlee


如果測試檔都沒問題, 是否可能實際資料有公式產生的錯誤值???
自行先找到錯誤所在, 即錯誤在資料, 而不是程式, 這要自己修改公式去除錯誤

TOP

        靜思自在 : 每天無所事事,是人生的消費者,積極、有用才是人生的創造者。
返回列表 上一主題