返回列表 上一主題 發帖

[發問] 改善迴圈速度及工作頁資料匯總

[發問] 改善迴圈速度及工作頁資料匯總

各位高手, 我想利用VBA將不同工作表的料號品名等資料匯總到一個工作頁中, 但是目前應該要38個料件要顯示出來, 但是怎麼弄卻只出現了22個料件, 請協助幫忙找出原因
另外, 下方填入PO/FCST的迴圈,非常耗時, 請問是否有什麼方式以改善迴圈的速度? 陣列是否可以改善? 謝謝
i = 12       '橫向填入料號
For C = 0 To 200
    If i > Worksheets.Count Then
        'Exit For
    Else
        A = Application.CountIf(Worksheets(i).Range("i5:z10"), "PO")
        b = Application.CountIf(Worksheets(i).Range("i1:z1"), "xxxx")
        EA = A - b
            For G = 0 To EA
            Worksheets("FCST").Range("b1").Offset(, C + G).Value = Worksheets(i).Name
            Worksheets("FCST").Range("b1").Offset(1, C + G).Value = Worksheets(i).Range("d1").Offset(0, G * 6) '料號
            Worksheets("FCST").Range("b1").Offset(2, C + G).Value = Worksheets(i).Range("c1").Offset(0, G * 6) '尺寸
            Worksheets("FCST").Range("b1").Offset(3, C + G).Value = Worksheets(i).Range("c2").Offset(0, G * 6) '廠商
            myRow = Worksheets(i).Range("a:a").Find(myToday).Row '直向填入PO/FCST數量
            k = 0
            For j = 0 To myDay
                If k > myDay Then
                    Exit For
                Else
                    If Worksheets(i).Range("e" & myRow).Offset(k + 1, G * 6).Value <> 0 Then
                        Worksheets("FCST").Range("a4").Offset(j + 2, C + 1 + G).Value =  "* " & Worksheets(i).Range("e" & myRow).Offset(k + 1, G * 6)
                    Else
                        Worksheets("FCST").Range("a4").Offset(j + 2, C + 1 + G).Value = Worksheets(i).Range("d" & myRow).Offset(k + 1, G * 6)
                    End If
                    k = k + 1
                End If
            Next j
            Next
    End If
    C = C + EA
i = i + 1
Next C
End If

回復 1# ivyhuang

沒有檔案~~~~~~~~~~~~~~~~

TOP

本帖最後由 mistery 於 2019-6-10 18:52 編輯

跑了三次迴圈,資料量一大,當然會耗時
建議先"篩選",再將篩選後的結果,轉到彙總用的工作表
這樣應該會比較快
(個人在處理上百萬筆的資料有發生類似的情形)(如果可以,直接用ACCESS 一拖一拉比較快)

因為沒有檔案, 截取一段"篩選"程式碼當參考

    Rows("1:1").AutoFilter Field:=7, Criteria1:="XX品項", Operator:=xlFilterValues     
    Set FR = ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
        For Each xR In FR
            If xR.Row > 1 Then      Cells(xR.Row, "I") =Application.WorksheetFunction.Subtotal(3, Range("A2:A" & Range("A1048576").End(xlUp).Row))
       Next

    Set FR = Nothing
    Rows("1:1").AutoFilter

TOP

本帖最後由 n7822123 於 2019-6-11 03:13 編輯

回復 1# ivyhuang

沒有檔案~~~~~~!
儲存格A.value=儲存格B.value
這種搬資料的方式本身就會比較
建議用陣列做運算,可加快速度~~準大一直教導的方式~

大略如下:

Dim Arr,Brr
Arr=範圍A
Brr=範圍B
for.....
    Brr(i,j)=Arr(i+2,j*2)
next
範圍B=Brr
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

        靜思自在 : 為自己找藉口的人永遠不會進步。
返回列表 上一主題