123
返回列表 上一主題 發帖

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

donod

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

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

將B組與A組有相同的PT組合(PT1-PT8)選出來，再把B組相關的分數顯示在P欄，請教大大如何寫才能做到?謝謝!
TEST A.rar (8.41 KB)
收藏 分享

oobird
　頭銜: 街友一族

超級版主Rank: 8Rank: 8

帖子
1572 
主題
16 
精華
2 
積分
1521 
點名
0  
作業系統
xp 
軟體版本
office 2003 
閱讀權限
150 
性別
男 
註冊時間
2010-5-1 
最後登錄
2016-1-13 

論壇貢獻勳章
2#
發表於 2012-2-26 07:58 | 只看該作者
歡迎新同學！
  1. Sub test()
  2.     Dim d As Object, a As Range, b As Range, i%, x$
  3.     Set d = CreateObject("Scripting.Dictionary")
  4.     Set b = [r7:ac18]
  5.     For i = 1 To b.Rows.Count
  6.         x = Join(Application.Transpose(Application.Transpose(b(i, 5).Resize(, 8))), ",")
  7.         d(x) = b(i, 1)
  8.     Next
  9.     Set a = [h7:o18]
  10.     For i = 1 To a.Rows.Count
  11.         x = Join(Application.Transpose(Application.Transpose(a(i, 1).Resize(, 8))), ",")
  12.         If d.exists(x) Then a(i, 9).Value = d(x)
  13.     Next
  14. End Sub
複製代碼

TOP

donod

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

回復 2# oobird


    謝謝大大回覆!
實際工作時，有多個工作頁，可否每個工作頁加入多個"選擇範圍按鈕"，請問如何寫才可以?謝謝!
TEST A2.rar (10.11 KB)

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2012-2-26 11:29 | 只看該作者
回復 3# donod
實際工作時，有多個工作頁
你舉的範例不是多個工作頁

TOP

donod

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

回復 4# GBKEE


    對不起!是我說不清楚!
是指會重複增開工作頁，而工作內容大約類同(範例用了相同內容)，都是各組配對A組。請教大大如何寫才做到。
TEST A3.rar (19.7 KB)

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
6#
發表於 2012-2-26 13:50 | 只看該作者
回復 5# donod
請複製到ThisWorkbook模組內
  1. 'ThisWorkbook 的預設事件
  2. Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  3.     Dim xX As Integer, Ar(), A As Range, B As Range, i As Integer, x As Variant
  4.     With Sh
  5.         If Target.Address(0, 0) = "P7" Then         '選擇了 P7
  6.             Set B = .Range("T10:AE21")              '制訂 B 組(分數- PT8) 範圍
  7.             xX = 0                                  ' P欄
  8.         ElseIf Target.Address(0, 0) = "Q7" Then     '選擇了 Q7
  9.             Set B = .Range("AH10:AS21")             '制訂 C組(分數-PT8) 範圍
  10.             xX = 1                                  ' P欄 右移一欄 :Q欄
  11.         ElseIf Target.Address(0, 0) = "R7" Then     '選擇了 R7
  12.             Set B = .Range("AV10:BG21")             '制訂 D組(分數-PT8) 範圍
  13.             xX = 2                                  ' P欄 右移二欄 :R欄
  14.         Else
  15.             Exit Sub                                 '離開程序
  16.         End If
  17.         Set A = .Range("H10:O21")                   '制訂 A 組(PT1-PT8) 範圍
  18.         A.Interior.ColorIndex = xlNone              '清除A 組(PT1-PT8) 範圍圖樣
  19.         B.Interior.ColorIndex = xlNone               '清除B ,C , D. 組 範圍圖樣
  20.         ReDim Ar(1 To A.Rows.Count)                 '重新宣告 陣列的維數
  21.         For i = 1 To B.Rows.Count                   '取得B,C,D,組的 (PT1-PT8) 的內容  置入陣列 Ar
  22.             Ar(i) = Join(Application.Transpose(Application.Transpose(B(i, 5).Resize(, 8))), ",")
  23.         Next
  24.         For i = 1 To A.Rows.Count
  25.             x = Join(Application.Transpose(Application.Transpose(A(i, 1).Resize(, 8))), ",")
  26.             x = Application.Match(x, Ar, 0)         '工作表函數Match 在Ar尋找 相同字串
  27.             A(i, 9 + xX) = ""                       '清除
  28.             If Not IsError(x) Then                  '找到傳回數字
  29.                 B(x, 5).Resize(, 8).Interior.ColorIndex = 6
  30.                 A(i, 1).Resize(, 8).Interior.ColorIndex = 6
  31.                 A(i, 9 + xX) = B(x, 1)               'B,C,D,組的分數
  32.             End If
  33.         Next
  34.     End With
  35. End Sub
複製代碼

TOP

donod

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


    可以了!感謝大大細心講解!

TOP

donod

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

回復 6# GBKEE


   22.    Ar(i) = Join(Application.Transpose(Application.Transpose(B(i, 5).Resize(, 8))), ",")
請教大大以上公式是什麼意思?B(i, 5)是指哪些位置?謝謝!

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2012-2-27 17:32 | 只看該作者
回復 8# donod
如 Set  B=[B2]
B(2, 5) = B.Cells(2, 5) =B.Offset(1, 4) =[F3]
-> B.Cells(2, 5)  ->含B2 的位置    向下位移2列  :  向右位移5欄    =[F3]
-> B.Offset(1, 4)->不含B2 的位置  向下位移1列  :   向右位移4欄  =[F3]

TOP

donod

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


    明白了，謝謝!

TOP

        靜思自在 : 多做多得。少做多失。
123
返回列表 上一主題