- 帖子
- 162
- 主題
- 33
- 精華
- 0
- 積分
- 243
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- excel 2003
- 閱讀權限
- 20
- 註冊時間
- 2018-1-5
- 最後登錄
- 2025-2-18
|
回復 coafort
新增程式碼到原有程式碼裡需要整理一下,請把整個工作表模組裡的程式碼貼上來
Andy2483 發表於 2024-2-2 14:17 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
'↑以下是關於儲存格編輯觸發的程序
If .Count > 1 Or .Item(1) = "" Then Exit Sub
'↑如果觸發格數量大於 1 或觸發格的下方格是空白!就結束程式執行
If Not Intersect([AR212:AR219,AX212:AX219,AD222,AF222], .Cells) Is Nothing Then
'↑如果觸發格是在[A2:A2]儲存格裡??
.Cells(1, 2) = Val(.Cells(1, 2)) + Val(.Value)
'↑令觸發格的右邊那1格的值 + (觸發格值以Val 函數轉化回傳的數值)
'觸發格本身是.Cells(1,1), 右側1格是.Cells(1,2), 左側1格是.Cells(1,0),
'上方1格是.Cells(0,1), 下方1格是.Cells(2,1)
.ClearContents
'↑清除觸發格的內容
'此清除的程序再次的觸發了,但是 .Item(1) = "" 所以結束程式執行
End If
End With
End Sub
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim a As Range, b As Range, c As Range
With Target
Set b = [AG212:AG219,AF212:AF219]
Set c = [AR212:AR219,AX212:AZ219]
For Each a In b
If a.Interior.ColorIndex = 6 Then a.Interior.ColorIndex = xlNone
Next
Set c = Intersect(.Cells, c)
If Not c Is Nothing Then Intersect(c.EntireRow, b).Interior.ColorIndex = 6
End With
End Sub
謝謝大大
:D |
|
發表於 2024-2-2 15:30
| 
