123
返回列表 上一主題 發帖

[發問] 如何自動選取相同的組合

donod

帖子
140 
主題
24 
精華
0 
積分
167 
點名
0  
作業系統
WIN 7 
軟體版本
OFFICE 2007 
閱讀權限
20 
性別
男 
註冊時間
2012-2-26 
最後登錄
2023-1-30 
21# 跳轉到 »
發表於 2012-2-28 21:56 | 只看該作者
回復 20# GBKEE


    明白，就如兩位大大所說，每張工作表有相同之格式是最方便。
再次謝謝兩位大大教導!

TOP

donod

帖子
140 
主題
24 
精華
0 
積分
167 
點名
0  
作業系統
WIN 7 
軟體版本
OFFICE 2007 
閱讀權限
20 
性別
男 
註冊時間
2012-2-26 
最後登錄
2023-1-30 
22#
發表於 2012-2-29 00:09 | 只看該作者
回復 20# GBKEE


    現在改用Workbook，但用了較多數據，沒有顯示結果，煩請大大檢查，謝謝!
TEST A9.rar (781.57 KB)

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
23#
發表於 2012-2-29 00:47 | 只看該作者
回復 22# donod
  1. Option Explicit
  2. 'ThisWorkbook 的預設事件
  3. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  4. Dim xX As Integer, Ar(), A As Range, B As Range, i As Integer, x As Variant
  5. With Sh
  6.     If Target.Address(0, 0) = "R8" Then         '選擇了 P7
  7.         Set B = Range("Z9:AO1500")              '制訂 B 組(最頂1個利潤- 最後最底1個OPT) 範圍
  8.         '而Set B = .Range("V9:AJ20"), Range之前 有 一點 代表是 以 With Target 為基點 所擴展的範圍
  9.         '  B.Select                             ' 加上這行 可顯示 B的範圍在哪裡
  10.         xX = 0                                  ' P欄
  11.     ElseIf Target.Address(0, 0) = "S8" Then     '選擇了 Q7
  12.         Set B = Range("AR9:BG1500")             '制訂 C組(最頂1個利潤- 最後最底1個OPT) 範圍
  13.         'B.Select
  14.         xX = 1                                  ' P欄 右移一欄 :Q欄
  15.     ElseIf Target.Address(0, 0) = "T8" Then     '選擇了 R7
  16.         Set B = Range("BJ9:BY1500")             '制訂 D組(最頂1個利潤- 最後最底1個OPT) 範圍
  17.         xX = 2                                  ' P欄 右移二欄 :R欄
  18.     ElseIf Target.Address(0, 0) = "U8" Then     '選擇了 Q7
  19.         Set B = Range("CB9:CQ1500")             '制訂 C組(最頂1個利潤- 最後最底1個OPT) 範圍
  20.         xX = 3                                  ' P欄 右移3欄 :Q欄
  21.     ElseIf Target.Address(0, 0) = "V8" Then     '選擇了 R7
  22.         Set B = Range("CT9:DI1500")             '制訂 D組(最頂1個利潤- 最後最底1個OPT) 範圍
  23.         xX = 4                                  ' P欄 右移4欄 :R欄
  24.     ElseIf Target.Address(0, 0) = "W8" Then     '選擇了 R7
  25.         Set B = Range("DL9:EA1500")             '制訂 D組(最頂1個利潤- 最後最底1個OPT) 範圍
  26.         xX = 5                                  ' P欄 右移5欄 :R欄
  27.     Else
  28.         Exit Sub                                '離開程序
  29.     End If
  30.     Set A = Range("H9:Q1500")                   '制訂 A 組(全部OPT) 範圍
  31.     A.Interior.ColorIndex = xlNone              '清除A 組(OPT1-OPT10) 範圍圖樣
  32.     B.Interior.ColorIndex = xlNone              '清除B ,C , D. 組 範圍圖樣
  33.     ReDim Ar(1 To A.Rows.Count)                 '重新宣告 陣列的維數
  34.     For i = 1 To B.Rows.Count                   '取得B,C,D,組的 (OPT1-OPT10) 的內容  置入陣列 Ar
  35.         Ar(i) = Join(Application.Transpose(Application.Transpose(B(i, 7).Resize(, 10))), ",")
  36.     Next
  37.     For i = 1 To A.Rows.Count
  38.         x = Join(Application.Transpose(Application.Transpose(A(i, 1).Resize(, 10))), ",")
  39.         x = Application.Match(x, Ar, 0)         '工作表函數Match 在Ar尋找 相同字串
  40.         A(i, 11 + xX) = ""                      '清除
  41.         If Not IsError(x) Then                  '找到傳回數字
  42.             B(x, 7).Resize(, 10).Interior.ColorIndex = 6
  43.             A(i, 1).Resize(, 10).Interior.ColorIndex = 6
  44.             A(i, 11 + xX) = B(x, 1)             'B,C,D,組的分數
  45.         End If
  46.     Next
  47. End With
  48. End Sub
複製代碼

TOP

donod

帖子
140 
主題
24 
精華
0 
積分
167 
點名
0  
作業系統
WIN 7 
軟體版本
OFFICE 2007 
閱讀權限
20 
性別
男 
註冊時間
2012-2-26 
最後登錄
2023-1-30 
24#
發表於 2012-2-29 02:39 | 只看該作者
回復 23# register313


    謝謝大大!
35.        Ar(i) = Join(Application.Transpose(Application.Transpose(B(i, 7).Resize(, 10))), ",")
40.        A(i, 11 + xX) = ""
請問以上的(B(i, 7).Resize(, 10))  和  A(i, 11 + xX)是指什麼位置?

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
25#
發表於 2012-2-29 09:23 | 只看該作者
回復 24# donod

Set B = Range("Z9:AO1500")
則B(1,1)= Range("Z9")   B(1,2)= Range("AA9")   B(1,3)= Range("AB9")  …
  B(2,1)= Range("Z10")   B(2,2)= Range("AA10")   B(2,3)= Range("AB10")  …
若i=1,則B(i, 7).Resize(, 10)= B(1, 7).Resize(, 10)= Range("AF9").Resize(, 10) = Range("AF9:AO9")
若i=2,則B(i, 7).Resize(, 10)= B(2, 7).Resize(, 10)= Range("AF10").Resize(, 10) = Range("AF10:AO10")

Set A = Range("H9:Q1500")
若xX=0,i=1,則A(i, 11 + xX)= A(1, 11)= Range("R9")
若xX=0,i=2,則A(i, 11 + xX)= A(2, 11)= Range("R10")

TOP

donod

帖子
140 
主題
24 
精華
0 
積分
167 
點名
0  
作業系統
WIN 7 
軟體版本
OFFICE 2007 
閱讀權限
20 
性別
男 
註冊時間
2012-2-26 
最後登錄
2023-1-30 
26#
發表於 2012-2-29 11:06 | 只看該作者
回復 25# register313


    謝謝大大回覆!明白更多了。
如果其他組首300個PT組合個別跟A組首50個PT組合配對，請教應如何改寫?

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
967 
主題
0 
精華
0 
積分
1001 
點名
0  
作業系統
WIN XP 
軟體版本
OFFICE 2003 
閱讀權限
50 
性別
男 
來自
台北 
註冊時間
2010-11-29 
最後登錄
2022-5-17 

2012龍年全勤獎章熱烈參與勳章
27#
發表於 2012-2-29 11:57 | 只看該作者
回復 26# donod

看看對不對
  1. Option Explicit
  2. 'ThisWorkbook 的預設事件
  3. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  4. Dim xX As Integer, Ar(), Br(), A As Range, B As Range, i As Integer, x As Variant
  5. With Sh
  6.     If Target.Address(0, 0) = "R8" Then         '選擇了 P7
  7.         Set B = Range("Z9:AO9").Resize(300)     '制訂 B 組(最頂1個利潤- 最後最底1個OPT) 範圍
  8.         '而Set B = .Range("V9:AJ20"), Range之前 有 一點 代表是 以 With Target 為基點 所擴展的範圍
  9.         '  B.Select                             ' 加上這行 可顯示 B的範圍在哪裡
  10.         xX = 0                                  ' P欄
  11.     ElseIf Target.Address(0, 0) = "S8" Then     '選擇了 Q7
  12.         Set B = Range("AR9:BG9").Resize(300)    '制訂 C組(最頂1個利潤- 最後最底1個OPT) 範圍
  13.         'B.Select
  14.         xX = 1                                  ' P欄 右移一欄 :Q欄
  15.     ElseIf Target.Address(0, 0) = "T8" Then     '選擇了 R7
  16.         Set B = Range("BJ9:BY9").Resize(300)    '制訂 D組(最頂1個利潤- 最後最底1個OPT) 範圍
  17.         xX = 2                                  ' P欄 右移二欄 :R欄
  18.     ElseIf Target.Address(0, 0) = "U8" Then     '選擇了 Q7
  19.         Set B = Range("CB9:CQ9").Resize(300)    '制訂 C組(最頂1個利潤- 最後最底1個OPT) 範圍
  20.         xX = 3                                  ' P欄 右移3欄 :Q欄
  21.     ElseIf Target.Address(0, 0) = "V8" Then     '選擇了 R7
  22.         Set B = Range("CT9:DI9").Resize(300)    '制訂 D組(最頂1個利潤- 最後最底1個OPT) 範圍
  23.         xX = 4                                  ' P欄 右移4欄 :R欄
  24.     ElseIf Target.Address(0, 0) = "W8" Then     '選擇了 R7
  25.         Set B = Range("DL9:EA9").Resize(300)    '制訂 D組(最頂1個利潤- 最後最底1個OPT) 範圍
  26.         xX = 5                                  ' P欄 右移5欄 :R欄
  27.     Else
  28.         Exit Sub                                '離開程序
  29.     End If
  30.     Set A = Range("H9:Q9").Resize(50)                   '制訂 A 組(全部OPT) 範圍
  31.     A.Interior.ColorIndex = xlNone              '清除A 組(OPT1-OPT10) 範圍圖樣
  32.     B.Interior.ColorIndex = xlNone              '清除B ,C , D. 組 範圍圖樣
  33.   ' ReDim Ar(1 To A.Rows.Count)                 '重新宣告 陣列的維數
  34.     ReDim Br(1 To B.Rows.Count)
  35.     For i = 1 To B.Rows.Count                   '取得B,C,D,組的 (OPT1-OPT10) 的內容  置入陣列 Ar
  36.         Br(i) = Join(Application.Transpose(Application.Transpose(B(i, 7).Resize(, 10))), ",")
  37.     Next
  38.     For i = 1 To A.Rows.Count
  39.         x = Join(Application.Transpose(Application.Transpose(A(i, 1).Resize(, 10))), ",")
  40.         x = Application.Match(x, Br, 0)         '工作表函數Match 在Ar尋找 相同字串
  41.         A(i, 11 + xX) = ""                      '清除
  42.         If Not IsError(x) Then                  '找到傳回數字
  43.             B(x, 7).Resize(, 10).Interior.ColorIndex = 6
  44.             A(i, 1).Resize(, 10).Interior.ColorIndex = 6
  45.             A(i, 11 + xX) = B(x, 1)             'B,C,D,組的分數
  46.         End If
  47.     Next
  48. End With
  49. End Sub
複製代碼

TOP

donod

帖子
140 
主題
24 
精華
0 
積分
167 
點名
0  
作業系統
WIN 7 
軟體版本
OFFICE 2007 
閱讀權限
20 
性別
男 
註冊時間
2012-2-26 
最後登錄
2023-1-30 
28#
發表於 2012-2-29 12:36 | 只看該作者
回復 27# register313


    可行了，也知多點，謝謝大大教導!

TOP

        靜思自在 : 自己害自己，莫過於亂發脾氣。
123
返回列表 上一主題