1234
返回列表 上一主題 發帖

[發問] VBA_請簡化程式碼。謝謝!

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
21# 跳轉到 »
發表於 2015-11-23 10:20 | 只看該作者
本帖最後由 Airman 於 2015-11-23 10:24 編輯

回復 20# GBKEE
GBKEE超大:
不好意思，有點誤差~但不好說明，小弟盡力就是~
07,39只是舉例符合範例中之期數的交集數字，~所以交集數字是依據有數字的T欄之對應R欄期數而變化。

因此~小弟將列12改為:
For Each E In Array(.Range("R" & b.Row).Value, .Range("R" & b.Row) - .[T3], .Range("R" & b.Row) - .[T3] * 2) '期別的迴圈
程式就中斷了。

請教:
x_No = Array(7, 39)和"期別的迴圈"或其它相關的程式碼應如何再修正?
敬請賜正!謝謝您:lol

PS:交集的數字範圍:01~49。可能有1個，可能有2個，....最多7個。

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
22#
發表於 2015-11-23 11:33 | 只看該作者
回復 21# Airman
你想要某一期數中開出的號碼(最多7個)或是指定的號碼,在下幾期中標出顏色
數字範圍:01~49。可能有1個，可能有2個，....最多7個。   
所以交集數字是依據有數字的T欄之對應R欄期數而變化
你的規律邏輯 ,附檔中可指明嗎? 說清楚.


  1. For Each E In Array(.Range("R" & b.Row).Value, .Range("R" & b.Row) - .[T3], .Range("R" & b.Row) - .[T3] * 2)
複製代碼

沒程式碼看不懂 ,
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
23#
發表於 2015-11-23 12:11 | 只看該作者
回復 22# GBKEE
  就如附檔中的列19~列33
For i = 10 To 16
   For j = 10 To 16
    For k = 10 To 16
           If .Cells(.Range("R" & b.Row) + 6, i) = .Cells(.Range("R" & b.Row) - .[T3] + 6, j Then
           If .Cells(.Range("R" & b.Row) + 6, i) = .Cells(.Range("R" & b.Row) - .[T3] * 2 + 6, k) Then
           If .Cells(.Range("R" & b.Row) - .[T3] + 6, j) = .Cells(.Range("R" & b.Row) - .[T3] * 2 + 6, k) Then
              .Cells(.Range("R" & b.Row) + 6, i).Interior.ColorIndex = 4
              .Cells(.Range("R" & b.Row) - .[T3] + 6, j).Interior.ColorIndex = 45
              .Cells(.Range("R" & b.Row) - .[T3] * 2 + 6, k).Interior.ColorIndex = 8
           End If
           End If
           End If

簡單的說:就是將上述程式碼的需求化為貴程式碼~然後將上述的程式碼移除即可。

可能是因為貴程式碼少了類似#11的程式碼~
Application.Goto .Range("T7:T" & .[R7].End(xlDown).Row)

For Each b In Selection
If b <> "" Then
...
Next b
所以(.Range("R" & b.Row) 套不進去貴程式中之"期別的迴圈"~
小弟VBA初學，只是猜測可能的原因~不敢就此妄斷

以上 謹供參考!謝謝您!

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-25 
24#
發表於 2015-11-23 18:26 | 只看該作者
回復 14# Airman


If R(y) Is Nothing Then U = 1: Exit For
底下加一行：
If y > 1 Then If R(y).Column <> R(y-1).Column Then U = 1: Exit For　'三區任一欄位不同　

TOP

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
25#
發表於 2015-11-23 19:01 | 只看該作者
回復 24# 准提部林
准大:
測試OK了~感恩
小弟以為要改為Offset，弄了老半天，就是跑不出結果

#15可否請您再次指導~謝謝您

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-25 
26#
發表於 2015-11-23 20:58 | 只看該作者
回復 23# Airman

雖有原來的程式碼，沒有文字詳細說明規則，及舉實例說明，超板應很不好下手去做簡化；

程式碼自己寫的，自己看得懂，要修改時還有個下手處，所以小幅修改如下：
For i = 10 To 16:  For j = 10 To 16:  For k = 10 To 16
　　If .Cells(b(1, -1) + 6, i) = .Cells(b(1, -1) - .[T3] + 6, j) And _
　　　　.Cells(b(1, -1) + 6, i) = .Cells(b(1, -1) - .[T3] * 2 + 6, k) Then
　　　　.Cells(b(1, -1) + 6, i).Interior.ColorIndex = 4
　　　　.Cells(b(1, -1) - .[T3] + 6, j).Interior.ColorIndex = 45
　　　　.Cells(b(1, -1) - .[T3] * 2 + 6, k).Interior.ColorIndex = 8
　　End If
Next k:  Next j:  Next i

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
.Cells(.Range("R" & b.Row) + 6, i)　改成　.Cells(b(1, -1) + 6, i)　＿b格往左２格即為Ｒ欄的期數格
３個If改成２個即可，A=B and A=C　即必定A=C

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-25 
27#
發表於 2015-11-23 21:01 | 只看該作者
回復 23# Airman

若要３列同欄相同：
For i = 10 To 16
　　If .Cells(b(1, -1) + 6, i) = .Cells(b(1, -1) - .[T3] + 6, i) And _
　　　　.Cells(b(1, -1) + 6, i) = .Cells(b(1, -1) - .[T3] * 2 + 6, i) Then
　　　　.Cells(b(1, -1) + 6, i).Interior.ColorIndex = 4
　　　　.Cells(b(1, -1) - .[T3] + 6, i).Interior.ColorIndex = 45
　　　　.Cells(b(1, -1) - .[T3] * 2 + 6, i).Interior.ColorIndex = 8
　　End If
Next i

TOP

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
28#
發表於 2015-11-24 01:38 | 只看該作者
本帖最後由 Airman 於 2015-11-24 01:44 編輯

回復 27# 准提部林
准大:
感謝您的賜教!多學習了另種程式寫法。感恩:lol

"程式碼自己寫的，自己看得懂"
小弟可能是在"認知上"有誤解了~超版大都已經看得懂貴語法~
因為自己覺得小弟寫的是最粗淺一條一條逐條敘述的語法，而且有範例，以為大家應該都看得懂，所以沒有再加註~
這一點經您一說，對超版大深覺抱歉!在此特向超版大謹致歉意:L

其實這次會想簡化程式碼，起因是想儘量少用迴圈，除了提升執行效率也減少變數得使用，再者是拜讀您簡化的語法後，覺得很接近A知識長的寫法~
且更簡扼易懂，然後又拜讀超版大的語法，又更簡呃，所以才又將交集值語法提出簡化需求~
給二位先進添麻煩，深感不安，敬請涵諒!

TOP

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
29#
發表於 2015-11-24 02:56 | 只看該作者
本帖最後由 Airman 於 2015-11-24 03:07 編輯

回復 22# GBKEE
超版大:
抱歉!小弟覺得自己寫的是最粗淺一條一條逐條敘述的語法，而且有範例，所以沒有再加註~不察之處，敬請涵量:L

小弟有將貴程式嘗試添修~
        Sheets(1).Range("J7", "P" & Sheets(2).[R6] + 5).Copy .[J7]

        'Set Rng = .Range("T7:T" & .[R7].End(xlDown).Row)        
       Application.Goto .Range("T7:T" & .[R7].End(xlDown).Row)        
        For Each b In Selection
        
         If b <> "" Then        
        E = Array(.Range("R" & b.Row).Value, .Range("R" & b.Row) - .[T3], .Range("R" & b.Row) - .[T3] * 2) '期別的陣列

            For Each x In x_No   '比對數字的迴圈             .
              ......
             ......
         End If
       Next b

但因不知 x_No = Array(7, 39)等交集數字的相關語法要怎麼改?所以只這樣添加~程式會中斷在For Each x In x_No

交集數字取得的邏輯︰
當T欄有顯示數字的儲存格，且當其在R欄的對應期數(即.Range("R" & b.Row))及該R欄的對應期數-T$3(即.Range("R" & b.Row)-T$3)及該R欄的對應期數-T$3*2(即.Range("R" & b.Row)-T$3*2)等3個期數同時都有相同數字，則該相同數字即為3個期數的交集值。

本題需求說明:
當T欄有顯示數字的儲存格，且當其在R欄的對應期數(即.Range("R" & b.Row))及該R欄的對應期數-T$3(即.Range("R" & b.Row)-T$3)及該R欄的對應期數-T$3*2(即.Range("R" & b.Row)-T$3*2)~
等3個期數有一個(含)以上的交集值時，則交集值的儲存格標示4,45,8底色。
EX︰範例中的T96有顯示數字，且其對應R欄的期數(90)及該R欄的對應期數-T$3(90-9=81)及該R欄的對應期數-T$3*2(90-9*2=72)~
等3個期數有一個(含)以上的交集值(07,39)時，則J96,P96標示4號底色；K87,M87標示45號底色；J78,K78標示8號底色。

以上 謹供參考!謝謝您!

TEST_2-G.rar (62.14 KB)

TOP

Airman

帖子
315 
主題
51 
精華
0 
積分
367 
點名
0  
作業系統
win7 
軟體版本
office2003 
閱讀權限
20 
性別
男 
註冊時間
2015-9-29 
最後登錄
2021-10-12 
30#
發表於 2015-11-24 05:21 | 只看該作者
回復 26# 准提部林
准大:您好!
不好意思，恕小弟執著，還是希望您能賜教如11#的寫法~
因為11#的貴語法，同欄與不限同欄的區分~只要多加一列程式碼~
f y > 1 Then If R(y).Column <> R(y-1).Column Then U = 1: Exit For
非常簡捷便利。

懇請您撥冗惠予賜教為禱~感恩　

小弟以貴程式依樣畫葫蘆~嘗試做個範例:
TEST_2-准.rar (63.13 KB)
謹供參考!謝謝您!

TOP

        靜思自在 : 真正的愛心，是照顧好自己的這顆心。
1234
返回列表 上一主題