由于循环，Excel性能问题

我拥有的：
1.）从每个客户的总金额计算独立商品的价格的Excelmacros（独立商品位于“商品”，总计在“付款”）。
2.）单独的表格，每个产品的价格。 有了数据，我填写了字典“PrDic”。
3.）计算公式大致是：
（每个产品的价格总额/从特定客户收到的付款总额）*（单独产品的辅助表格中的价格）
我需要的：
我在处理大量数据时遇到了性能问题，我猜测连续两个循环会减慢我的代码，是否有任何解决方法？

Sub TIrl() Dim ws1 As Worksheet, ws2 As Worksheet Dim vis As Range Dim i As Integer, SumC, SumR, Rows1, Rows2 Dim Key As String, FCrit As String Set ws1 = ThisWorkbook.Worksheets("Payment") Set ws2 = ThisWorkbook.Worksheets("Products") 'Fills dictionary PrDiC (Dictionary of prices per product) Call PrDic Call FDrop(ws1) Rows1 = ws1.Range("A" & "65536").End(xlUp).Row Call FDrop(ws2) Rows2 = ws2.Range("A" & "65536").End(xlUp).Row ws2.Range("AE10", "AE" & Rows2).Value = Empty Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For i = 3 To Rows1 SumR = 0 SumC = ws1.Cells(i, 24) FCrit = ws1.Cells(i, 1) With ws2 If .AutoFilterMode Then .AutoFilterMode = False .Range(Cells(9, 1), Cells(Rows2, 31)).AutoFilter _ Field:=2, Criteria1:=FCrit .Range(Cells(9, 1), Cells(Rows2, 31)).AutoFilter _ Field:=13, Criteria1:="Yes" ACount = -1 For Each vis In .AutoFilter.Range.Resize(, 1).SpecialCells(xlCellTypeVisible) ACount = ACount + 1 Next vis If ACount = 1 Then .Cells(.Range("B10", "B" & Rows2).SpecialCells(xlCellTypeVisible).Row, 31) = SumC Else For Each vis In .Range("B10", "B" & Rows2).SpecialCells(xlCellTypeVisible) Key = .Cells(vis.Row, 26) If .Cells(vis.Row, 31) <> "fl" Then If .Cells(vis.Row, 18) <> 0 Then .Cells(vis.Row, 31) = .Cells(vis.Row, 18) * DICT(Key) Else .Cells(vis.Row, 31) = 1 * DICT(Key) End If Else .Cells(vis.Row, 31) = 1.05 * DICT(Key) End If SumR = SumR + .Cells(vis.Row, 31) Next For Each vis In .Range("B10", "B" & Rows2).SpecialCells(xlCellTypeVisible) .Cells(vis.Row, 31) = Round((.Cells(vis.Row, 31) * SumC) / SumR, 2) Next End If End With Next i Call FDrop(ws2) Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox ("Done!") ws2.Activate End Sub