返回列表 上一主題 發帖

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

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
1# 跳轉到 »
發表於 2015-11-21 12:42 | 顯示全部帖子
操作程式時, Sheets(2)不是當前工作表, 須先跳轉:
With Sheets(2)
        .Select
      .Range("T7:T" & tx).Select 這行才不會錯誤

不過, 工作表跳轉若非必要, 可:
      For Each b In .Range("T7:T" & tx)  '不用Selection, 上兩行可刪去

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
2#
發表於 2015-11-21 15:16 | 顯示全部帖子
回復 3# Airman


    .[A1].Activate
End With

[A1]是Sheets(2)的, 要放在With裡面!

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
3#
發表於 2015-11-21 20:30 | 顯示全部帖子
本帖最後由 准提部林 於 2015-11-21 20:31 編輯

回復 5# Airman


If .Cells(.[T5] + 6, J) = .[R5] Then
If .Cells(.[T5] - .[T3] + 6, J) = .[R5] Then
If .Cells(.[T5] - .[T3] * 2 + 6, J) = .[R5] Then
∼∼
∼∼
∼∼
End If
End If
End If

看不懂為何這樣寫，須三個if都成立，才進行之內的操作，
是否應各自分段：
If .Cells(.[T5] + 6, J) = .[R5] Then
∼∼
End If
If .Cells(.[T5] - .[T3] + 6, J) = .[R5] Then
∼∼
End If
If .Cells(.[T5] - .[T3] * 2 + 6, J) = .[R5] Then
∼∼
End If

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
4#
發表於 2015-11-22 18:55 | 顯示全部帖子
本帖最後由 准提部林 於 2015-11-22 18:57 編輯

三列〔同時〕出現 [R5]，填入不同底色：

Private Sub CommandButton1_Click()
Dim b As Range, RW, y%
With Sheets(2)
　　　Sheets(1).Range("J7", "P" & Sheets(2).[R6] + 5).Copy .[J7]
　　　Application.Goto .Range("T7:T" & .[R7].End(xlDown).Row)　'不用Select，直接跳選目標區　
　　　RW = Array(.[T5], .[T5] - .[T3], .[T5] - .[T3] * 2)　'３區的期數陣列　
　　　For Each b In Selection
　　　　　If b <> "" Then
　　　　　If .Range("R" & b.Row) + 1 = .[T5] And .Range("R" & b.Row) - .[T3] * 2 > 6 Then
　　　　　　　Dim R(1 To 3) As Range, U%
　　　　　　　For y = 1 To 3
　　　　　　　　　Set R(y) = .[J:P].Rows(RW(y - 1) + 6).Find(.[R5], Lookat:=xlWhole)　'標定３區[R5]值的儲存格　
　　　　　　　　　If R(y) Is Nothing Then U = 1: Exit For　'若任一區不含 [R5]，以 U=1 表示，跳出　
　　　　　　　Next y
　　　　　　　If U = 0 Then　'３區皆含[R5]
　　　　　　　　　For y = 1 To 3: R(y).Interior.ColorIndex = Array(4, 45, 8)(y - 1): Next　'標示〔個別〕底色　
　　　　　　　　　With Union(R(1), R(2), R(3)).Font: .ColorIndex = 3: .FontStyle = "粗體": End With　'設定文字　
　　　　　　　End If
　　　　　End If
　　　　　End If
　　　Next b
　　　.[A1].Select
End With
End Sub

可簡化的不多，參考超板的方法減少三層的迴圈而已！　

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
5#
發表於 2015-11-22 20:31 | 顯示全部帖子
回復 12# Airman


只憑所提供的程式碼, 要回溯原需求規則, 除費時費眼力外, 並非易事,
還好有超板專業老手打先鋒, 我插花寫不同需求罷了~~

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
6#
發表於 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

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
7#
發表於 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

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
8#
發表於 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

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
9#
發表於 2015-11-24 11:10 | 顯示全部帖子
本帖最後由 准提部林 於 2015-11-24 12:18 編輯

回復 30# Airman


x_No = Array(7, 39)　超板還是以為7,39是〔已知〕條件，所以我才說要加註說明！！^ ^

試著以如下去解說：
有Ａ．Ｂ．Ｃ三區，每區７格，每區各有７個１∼４９不重覆數字，
找出這三區〔共有〕的數字並分別填入底色 （共有數字須先行檢測，無預設值），
例如下方範例，檢測後取得共同數字為：０７．３９．１３
Ａ區：
07121728394313

Ｂ區：
01071339424549

Ｃ區：
07091320213949

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
#11 是以〔一個數字〕去比封三區，所以較簡單，
此需求是７個數字逐一比對三區，1 To 3 及 1 To 7 迴圈省不了，因為欄位不一樣，
若要求數字及欄位相同，即如#27，用 1 To 7 迴圈即可，反而較省事；
以此需求的迴圈不算大，應還不太影響運行速度，
若減少迴圈以函數代替，也並不見得較好，畢竟函數的效率有時會降低速度∼∼

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
10#
發表於 2015-11-24 21:07 | 顯示全部帖子
不是簡化，另一種寫法，比原使用３層迴圈更不易理解，參考罷：

RW = Array(b(1, -1), b(1, -1) - .[T3], b(1, -1) - .[T3] * 2)
For y = 1 To 3: Set R(y) = .[J:P].Rows(RW(y - 1) + 6).Cells: Next y
Dim M(1 To 3)
For k = 1 To 7
　　M(1) = k
　　For y = 2 To 3
　　　　M(y) = Application.Match(R(1)(k), R(y), 0)
　　　　If IsError(M(y)) Then M(1) = 0: Exit For
　　　　'If M(y) <> M(1) Then M(1) = 0: Exit For　'若要求〔同欄〕，加入這行　
　　Next y
　　If M(1) > 0 Then
　　　For y = 1 To 3: R(y)(M(y)).Interior.ColorIndex = Array(4, 45, 8)(y - 1): Next
　　End If
Next k

TOP

        靜思自在 : 難行能行，難捨能捨，難為能為，才能昇華自我的人格。
返回列表 上一主題