返回列表 上一主題 發帖

任選儲存格累加設定數值

本帖最後由 GBKEE 於 2011-11-18 07:04 編輯

回復 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
複製代碼

TOP

回復 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
複製代碼

TOP

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

TOP

本帖最後由 GBKEE 於 2011-11-18 09:41 編輯

回復 10# y663258
如1,2,3,5有出現就是1+2+4+16=23對照姓氏表宋,被猜者就是姓宋
Hsieh超版 的程式碼,3樓的程式碼 ,不就是如此嗎?
真是看不出你要的是什麼?

TOP

回復 13# y663258
Hsieh超版 的程式碼結果是16顯示郭,沒有累加所選過的數值1+2+4+16只選最後選擇的16。
有的是 23 不是 16  你再 試試看

TOP

回復 15# y663258
我3樓 的程式碼 你在工作上一一的點選範圍過後 執行 Sub Ex()  可顯示答案  嗎?
Hsieh 版大目前程式會顯示曾因是取最後選取的6=32沒有累右前三個選項1.2.3之實際數值1,2,4。
有阿 你是如何執行的
Hsieh超版 的程式碼 For Each a In Selection  你可能不了解 Selection這意思
請你在工作上先按住 Ctrl  鍵 然後 點選 1,2,3 的範圍後 執行程式碼 看看是否對的

TOP

        靜思自在 : 生氣,就是拿別人的過錯來懲罰自己。
返回列表 上一主題