任選儲存格累加設定數值

y663258

各位大大:如附件說明自己找資料就是湊不出程式，請協助謝謝。

Hsieh

回復 1# y663258


    你的舉例C16為何是16?

GBKEE

回復 1# y663258

1. Option Explicit
   
2. Public A As Integer
   
3. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
4.     Dim AR(1 To 7) As Range, i As Integer, s As Integer
   
5.     Application.EnableEvents = False
   
6.     Set AR(1) = [A3:E12]
   
7.     Set AR(2) = [G3:K12]
   
8.     Set AR(3) = [M3:Q12]
   
9.     Set AR(4) = [A15:E24]
   
10.     Set AR(5) = [G15:K24]
    
11.     Set AR(6) = [M15:P24]
    
12.     Set AR(7) = [A27:D37]
    
13.     For i = 1 To 7
    
14.         If i = 1 Then s = 1 Else s = s * 2
    
15.         If Not Intersect(Target(1), AR(i)) Is Nothing Then            A = s + A
    
16.     Next
    
17.     Application.EnableEvents = True
    
18. End Sub
    
19. Sub Ex()   '插入物件(圖片,文字框等..按鈕) 指定此巨集
    
20.     Dim Rng As Range
    
21.     Set Rng = Range("B39", Range("B39").End(xlDown))
    
22.     Rng(A).Select
    
23.     MsgBox Rng(A)
    
24.     A = 0
    
25. End Sub

複製代碼

y663258

Hsieh 大大C16是在4應是8，誤值了不好意思。

y663258

GBKEE 大大大謝謝幫忙         
    Dim Rng As Range
    Set Rng = Range("B39", Range("B39").End(xlDown))
    Rng(A).Select
    MsgBox Rng(A)
    A = 0
End Sub

經測試只顯示(姓氏)不能比對累加後數值顯示出姓氏，請再修正謝謝。

GBKEE

回復 5# y663258
'Module 的程式碼

1. Option Explicit
   
2. Public A()     'Module 的程式碼
   
3. Sub Ex()   '插入物件(圖片,文字框等..按鈕) 指定此巨集
   
4.     Dim Rng As Range, M As String, i
   
5.      Set Rng = Range("B39", Range("B39").End(xlDown))
   
6.     On Error GoTo Thend
   
7.     For i = 0 To UBound(A) - 1
   
8.         M = M & IIf(M <> "", " : ", "") & Rng(A(i))
   
9.     Next
   
10.     MsgBox M
    
11.     Erase A
    
12. Thend:
    
13. End Sub

複製代碼

Worksheet 的程式碼

1. Option Explicit
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3.     Dim AR(1 To 7) As Range, i As Integer, s As Integer
   
4.     Application.EnableEvents = False
   
5.     Set AR(1) = [A3:E12]
   
6.     Set AR(2) = [G3:K12]
   
7.     Set AR(3) = [M3:Q12]
   
8.     Set AR(4) = [A15:E24]
   
9.     Set AR(5) = [G15:K24]
   
10.     Set AR(6) = [M15:P24]
    
11.     Set AR(7) = [A27:D37]
    
12.     For i = 1 To 7
    
13.         If i = 1 Then s = 1 Else s = s * 2
    
14.         If Not Intersect(Target(1), AR(i)) Is Nothing Then
    
15.             On Error GoTo TEN:
    
16.             A(UBound(A)) = s
    
17.             ReDim Preserve A(UBound(A) + 1)
    
18.         End If
    
19.     Next
    
20.     Application.EnableEvents = True
    
21.     Exit Sub
    
22. TEN:
    
23. ReDim A(0)
    
24. Resume
    
25. End Sub

複製代碼

y663258

GBKEE 大大謝謝指導依示測試MsgBox顯示是點選過的姓氏,可否顯示點選過累加的姓氏，
    如點選b4 ,h4,n4,g22=1+2+4+16=23比對b39:b138MsgBox顯然宋。

Hsieh

回復 7# y663258

1. Sub nn()
   
2. Dim ar As Range
   
3. Set ar = Union([A3:E12], [G3:K12], [M3:Q12], [A15:E24], [G15:K24], [M15:P24], [A27:D37])
   
4. For Each a In Selection
   
5. s = 1
   
6. For Each c In ar.Areas
   
7.   Set b = Intersect(a, c)
   
8.   If Not b Is Nothing Then cnt = cnt + s: Exit For
   
9.   s = s * 2
   
10. Next
    
11. Next
    
12. MsgBox [B39:B138].Cells(cnt, 1)
    
13. End Sub

複製代碼

GBKEE

回復 7# y663258
請看    3樓已修正的程式碼.

y663258

謝謝二位大大不厭其煩撥冗指教，Hsieh 程式經測試，MsgBox 顯示的是，選取過的最後一組，小弟要的是選取過的累加合計數值所對應姓氏。如b4 ,h4,n4,g22=1+2+4+16=23比對b39:b138MsgBox顯然宋，這是猜姓氏的遊戲。在1-7請被猜者告訴猜測者1-7有出現姓氏的，如1，2，3，5有出現就是1+2+4+16=23對照姓氏表宋，被猜者就是姓宋，兄台再幫忙修正。