返回列表 上一主題 發帖

[發問] 5000列 3秒! 還可以更快嗎? (依條件帶值並上底色)

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2022-11-4 15:33 | 只看該作者

[發問] 5000列 3秒! 還可以更快嗎? (依條件帶值並上底色)

各位前輩好
因為範例與目的結果不同!所以另開主題請教各位前輩
後學想提升處裡儲存格格式的效能!請各位前輩指導
1.後學以往都是以儲存格或整欄.整列的方式,在各工作表或跨檔案處理資料,最後連同格式一起COPY到目的地
2.學習陣列與字典後 想將資料倒入陣列處理後在目的地貼上值!這樣效率提升很多!
3.但是畢竟有些儲存格需要改變格式(上底色.粗體...),不知道用什麼方式可以更快設定格式?
4.趁製作範例時練習正則

懇請前輩們指點!謝謝
依條件帶值並上底色_20221104_2.zip (422.28 KB)

原空結果表:


資料表:


執行後結果表:


程式碼如下:
Option Explicit
Sub 反向帶值_上色_TEST()
Dim Arr, R&, C%, Sh, Shu, reg, Find_Num, i&
Dim x%, y%, x1%, j%, T
T = Timer
Set Sh = Sheets("操作表")
Set Shu = Sheets("反操作表")
R = Shu.UsedRange.EntireRow.Rows.Count
C = Shu.UsedRange.EntireColumn.Columns.Count
Set reg = CreateObject("VBScript.RegExp")
reg.Pattern = "\d+"
reg.Global = True
For x = 2 To C Step 2
   For y = 3 To R
      Set Find_Num = reg.Execute(Shu.Cells(y, x))
      If Find_Num.Count > 0 Then
         Sh.Cells(Find_Num(0), Find_Num(1)).Interior.ColorIndex = _
         Shu.Cells(1, x + 1).Interior.ColorIndex
         Sh.Cells(Find_Num(0), Find_Num(1)) = Shu.Cells(y, x + 1)
      End If
   Next
Next
Sh.Activate
MsgBox Timer - T & " 秒"
End Sub
收藏 分享

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
2#
發表於 2022-11-24 09:49 | 只看該作者
謝謝各位前輩
'轉念!
'1.從資料庫裡帶出需要的資料查看或就可以了!
'不必要資料庫全部帶出資料上了底色,再篩選需要的資料
'2.為了查看使用而上色!沒有必要為上色而上色
'3.至於如果是為了編輯資料,而只帶出資料庫少部分資料!
'就練好技能,按個鈕將有編輯的資料快速反帶回資料庫就好了


以下心得註解請各位前輩指正並指導!謝謝
Option Explicit
Sub 反向帶值_上色_Detail()
Dim Arr, R&, C%, Sh, Shu, reg, Find_Num, i&
Dim x%, y%, Z&, T
'↑宣告變數
T = Timer
Z = 200
'↑設定想要查看資料的細部條件
Set Sh = Sheets("操作表")
'↑令Sh 是工作表
Set Shu = Sheets("反操作表")
'↑令Shu 是工作表
Sh.UsedRange.EntireRow.Delete
'↑操作表 有使用的列全部刪除
R = Shu.UsedRange.EntireRow.Rows.Count
'↑令R是 反操作表有使用的列數
C = Shu.UsedRange.EntireColumn.Columns.Count
'↑令C是 反操作表有使用的欄數
Set reg = CreateObject("VBScript.RegExp")
'↑令reg 是正則
reg.Pattern = "\d+"
'↑正則的規則是被非數字間隔的數字串
reg.Global = True
'↑正則後的資料全部都要!
For x = 2 To C Step 2
'↑設外順迴圈! 從2 到 反操作表有使用的欄數,每次繞回來x+2
   For y = 3 To R
   '↑設內順迴圈! 從2 到 反操作表有使用的列數
      Set Find_Num = reg.Execute(Shu.Cells(y, x))
      '↑令Find_Num 是迴圈儲存格執行正則之後的陣列
      If Find_Num.Count > 0 Then
      '↑如果 Find_Num陣列裡有資料??
         If Find_Num(0) Mod Z = 0 Then
         '↑如果 Find_Num陣列裡的第個數字 除以200的餘數是0(整除的意思)
            Sh.Cells(Find_Num(0) / Z, Find_Num(1)).Interior.ColorIndex = _
            Shu.Cells(1, x + 1).Interior.ColorIndex
            '↑操作表相對應的儲存格位置上底色
            Sh.Cells(Find_Num(0) / Z, Find_Num(1)) = Shu.Cells(y, x + 1)
            '↑操作表相對應的儲存格位置輸入值
         End If
      End If
   Next
Next
Sh.Activate
MsgBox Timer - T & " 秒"
End Sub

TOP

        靜思自在 : 做好事不能少我一人，做壞事不能多我一人。
返回列表 上一主題