[發問] vba程式碼簡化

以下程式碼，目前小弟是以迴圈方式設計，當資料大時跑的速度有點久，不知有其有辦法再簡化或其他方式執行??
sub aa()
Dim sht As Worksheet
For mon = 1 To 12
Application.EnableEvents = False
         For Each sht In Worksheets
            col = Sheets(mon & "月未結").Range("A1").End(xlToRight).Column
               r = Sheets(mon & "月未結").Range("AA1").Value
            For x = 7 To col
                           For y = 2 To r
                                    mony = Application.IfError(Application.VLookup(Sheets(mon & "月未結").Range("A" & y), Sheets("" & sht.Name).Range("A:U"), Application.Match(Sheets("" & sht.Name).Cells(1, x),
                                                      Sheets("" & sht.Name).Range("A1:U1"), 0), 0), "")
                              Sheets(mon & "月未結").Cells(y, x) = mony
                              Next
            Next
         End If
         Next
Application.EnableEvents = True
Next mon
end sub

樓主熱帖

linyancheng

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 228
主題: 73
精華: 2
積分: 333
點名: 0
作業系統: Windows 10
軟體版本: Office 2000, 2019
閱讀權限: 100
性別: 男
來自: 彰化縣
註冊時間: 2013-7-18
最後登錄: 2024-10-13

8^#

發表於 2021-9-10 16:24 | 只看該作者

回復 6# samwang

沒必要簡化，效率比較重要，有時候簡化反而效率降低！

Word呈現極致的靜態之美，Excel展現極致的動態之美。

TOP

棋語鳥鳴

中學生 Rank: 2

帖子: 178
主題: 53
精華: 0
積分: 242
點名: 0
作業系統: xp
軟體版本: 2007
閱讀權限: 20
註冊時間: 2011-2-22
最後登錄: 2024-7-5

7^#

發表於 2021-9-10 13:07 | 只看該作者

回復 5# samwang

測試功能正常，看來我也要好好學學如何使用陣列了
感謝大大

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

6^#

發表於 2021-9-10 11:54 | 只看該作者

本帖最後由 samwang 於 2021-9-10 11:56 編輯

回復 1# 棋語鳥鳴

當資料大時跑的速度有點久，不知有其有辦法再簡化或其他方式執行??
>>如#3 的ikboy大大說的轉用陣列會快得多， #5 程式是用陣列+字典速度比較快，但無法比您的程式碼在簡化
如果要再簡化且速度快，可能需要其他大大協助，謝謝。

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

5^#

發表於 2021-9-10 11:32 | 只看該作者

回復 4# 棋語鳥鳴

請測試看看，謝謝

Sub test()
Dim Arr, xD, T$, R%, C%, i&, j&
Application.EnableEvents = False
Tm = Timer
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([資料來源!k1], [資料來源!a65536].End(3))
For i = 2 To UBound(Arr)
xD(Arr(i, 1)) = 1
For j = 2 To UBound(Arr, 2)
      xD(Arr(i, 1) & "_" & Arr(1, j)) = Arr(i, j)
Next
Next
For Each sht In Worksheets
If InStr(sht.Name, "月") Then
      With Sheets(sht.Name)
         R = .Range("a65536").End(3).Row
         C = .Cells(1, Columns.Count).End(xlToLeft).Column
         Arr = .Range(.[a1], .Cells(R, C))
         For i = 2 To UBound(Arr)
            If xD(Arr(i, 1)) = 1 Then
                  For j = 2 To C
                     Arr(i, j) = xD(Arr(i, 1) & "_" & Arr(1, j))
                  Next
            End If
         Next
         .Range("a1").Resize(R, C) = Arr
      End With
End If
Next
MsgBox Timer - Tm
Application.EnableEvents = True
End Sub

TOP

棋語鳥鳴