Note: The other languages of the website are Google-translated. Back to English

如何計算Excel中指定單元格中的總點擊次數?

本文討論的是計算Excel中指定單元格中的總點擊次數。

使用VBA代碼計算指定單元格中的總點擊次數


使用VBA代碼計算指定單元格中的總點擊次數

請執行以下操作以計算Excel中指定單元格中的總點擊次數。

1.在工作表中包含您需要計算其總點擊次數的單元格,右鍵單擊工作表選項卡,然後單擊 查看代碼 從上下文菜單。

2。 在裡面 Microsoft Visual Basic for Applications 窗口,請將以下VBA代碼複製並粘貼到“代碼”窗口中。

VBA代碼:計算Excel中指定單元格中的總點擊次數

Public xRgS, xRgD As Range
Public xNum As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRgS = Range("E2")
    If xRgS Is Nothing Then Exit Sub
    Set xRgD = Range("H2")
    If xRgD Is Nothing Then Exit Sub
    If Intersect(xRgS, Target) Is Nothing Then Exit Sub
    xNum = xNum + 1
    xRgD.Value = xNum
End Sub

備註:在代碼中,E2是您需要計算其總點擊次數的單元格,而H2是該計數的輸出單元格。 請根據需要更改它們。

3。 按 其他 + Q 關閉鍵 Microsoft Visual Basic for Applications 窗口。

從現在開始,在此指定的工作表中單擊單元格E2時,總點擊次數將自動填充到單元格H2中,如下圖所示。 例如,如果您單擊單元格E2 5次,則數字5將顯示在單元格H2中。


最佳辦公效率工具

Kutools for Excel 解決了你的大部分問題,並將你的生產力提高了 80%

  • 重用: 快速插入 複雜的公式,圖表 以及您以前使用過的任何東西; 加密單元 帶密碼 創建郵件列表 並發送電子郵件...
  • 超級公式欄 (輕鬆編輯多行文本和公式); 閱讀版式 (輕鬆讀取和編輯大量單元格); 粘貼到過濾範圍...
  • 合併單元格/行/列 不會丟失數據; 拆分單元格內容; 合併重複的行/列...防止細胞重複; 比較範圍...
  • 選擇重複或唯一 行; 選擇空白行 (所有單元格都是空的); 超級查找和模糊查找 在許多工作簿中; 隨機選擇...
  • 確切的副本 多個單元格,無需更改公式參考; 自動創建參考 到多張紙; 插入項目符號,複選框等...
  • 提取文字,添加文本,按位置刪除, 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
  • 超級濾鏡 (將過濾方案保存並應用於其他工作表); 高級排序 按月/週/日,頻率及更多; 特殊過濾器 用粗體,斜體...
  • 結合工作簿和工作表; 根據關鍵列合併表; 將數據分割成多個工作表; 批量轉換xls,xlsx和PDF...
  • 超過 300 項強大的功能. 支持 Office / Excel 2007-2021 和 365。支持所有語言。 在您的企業或組織中輕鬆部署。 完整功能 30 天免費試用。 60 天退款保證。
kte選項卡201905

Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%,每天為您減少數百次鼠標點擊!
officetab底部
按評論排序
留言 (29)
還沒有評分。 成為第一位評論!
網站主持人對此評論進行了最小化
如何“重置”計數器?
網站主持人對此評論進行了最小化
親愛的丹尼斯,
請在原始代碼末尾添加以下 VBA 代碼。 每次運行此代碼時,計數都會重置為 0。感謝您的評論。

子清除計數()
xRgD.Value = ""
x數 = 0
END SUB
網站主持人對此評論進行了最小化
水晶,

您能否為此提供完整的 VBA 代碼? 另外我將如何將它應用於單行 - 每個都需要自己的計數器?
網站主持人對此評論進行了最小化
嗨,
完整的 VBA 代碼如下。 如果要重置計數器,請運行第二個 VBA 代碼。 要將代碼應用於單行,抱歉還不能幫助您。

'第一個VBA
公共 xRgS、xRgD 作為範圍
公共 xNum 只要
私人子工作表_SelectionChange(ByVal Target As Range)
在錯誤恢復下一頁
如果 Target.Cells.Count > 1 然後退出 Sub
設置 xRgS = Range("E2")
如果 xRgS 什麼都不是,則退出 Sub
設置 xRgD = Range("H2")
如果 xRgD 什麼都不是,則退出 Sub
如果 Intersect(xRgS, Target) 什麼都不是,則退出 Sub
xNum = xNum + 1
xRgD.Value = xNum
END SUB
'第二個VBA
子清除計數()
xRgD.Value = ""
x數 = 0
END SUB
網站主持人對此評論進行了最小化
謝謝你的代碼,非常有用。
我不是程序員,我想知道如何將此過程擴展到每一行。 也就是說,不僅E2>H2,還有E3>H3、E4>H4,以此類推。
有這個代碼嗎?


預先感謝您!
網站主持人對此評論進行了最小化
嗨圭多,

下面的 VBA 代碼可以幫助您解決問題。 請試一試。 謝謝你的評論。
私人子工作表_SelectionChange(ByVal Target As Range)
將 xRgArray 調暗為變體
暗x數
將 xStrR、xStrS、xStrD 調暗為字符串
將 xRgS、xRgD 調暗為範圍

將 xFNum 變暗
xRgArray = Array("E2,H2", "E3,H3", "E4,H4", "E5,H5", "E6,H6")
在錯誤恢復下一頁
如果 Target.Cells.count > 1 然後退出 Sub
對於 xFNum = LBound(xRgArray) 到 UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = 左(xStrR,2)
xStrD = ""
xStrD = 右(xStrR,2)
設置 xRgS = 無
設置 xRgS = Range(xStrS)
如果 TypeName(xRgS) <> "Nothing" 那麼
設置 xRgD = 無
設置 xRgD = Range(xStrD)
如果 TypeName(xRgD) <> "Nothing" 那麼
如果 TypeName(Intersect(xRgS, Target)) <> "Nothing" Then
xRgD.Value = xRgD.Value + 1
如果結束
如果結束
如果結束
下一頁
END SUB
網站主持人對此評論進行了最小化
謝謝你。 我試過了,它工作了,但它只工作到一定數量的單元格,我們如何將此代碼擴展到單元格的末尾? 例如,我在下面輸入此代碼,它僅在“G9,G9”之前有效。 謝謝


私人子工作表_SelectionChange(ByVal Target As Range)
將 xRgArray 調暗為變體
暗x數
將 xStrR、xStrS、xStrD 調暗為字符串
將 xRgS、xRgD 調暗為範圍

將 xFNum 變暗
xRgArray = Array("C4,C4", "D4,D4", "E4,E4", "F4,F4", "G4,G4", "C6,C6", "D6,D6", "E6,E6 ", "F6,F6", "G6,G6", "C7,C7", "D7,D7", "E7,E7", "F7,F7", "G7,G7", "C8,C8", “D8,D8”, “E8,E8”, “F8,F8”, “G8,G8”, “C9,C9”, “D9,D9”, “E9,E9”, “F9,F9”, “G9” ,G9”, “C10,C10”, “D10,D10”, “E10,E10”, “F10,F10”, “G10,G10”, “C11,C11”, “D11,D11”, “E11,E11” ", "F11,F11", "G11,G11", "C14,C14", "D14,D14", "E14,E14", "F14,F14", "G14,G14", "C15,C15", “D15,D15”, “E15,E15”, “F15,F15”, “G15,G15”, “C16,C16”, “D16,D16”, “E16,E16”, “F16,F16”, “G16” ,G16”, “C17,C17”, “D17,D17”, “E17,E17”, “F17,F17”, “G17,G17”, “C18,C18”, “D18,D18”, “E18,E18” ", "F18,F18", "G18,G18", "C20,C20", "D20,D20", "E20,E20", "F20,F20", "G20,G20")
在錯誤恢復下一頁
如果 Target.Cells.count > 1 然後退出 Sub
對於 xFNum = LBound(xRgArray) 到 UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = 左(xStrR,2)
xStrD = ""
xStrD = 右(xStrR,2)
設置 xRgS = 無
設置 xRgS = Range(xStrS)
如果 TypeName(xRgS) <> "Nothing" 那麼
設置 xRgD = 無
設置 xRgD = Range(xStrD)
如果 TypeName(xRgD) <> "Nothing" 那麼
如果 TypeName(Intersect(xRgS, Target)) <> "Nothing" Then
xRgD.Value = xRgD.Value + 1
如果結束
如果結束
如果結束
下一頁
END SUB
網站主持人對此評論進行了最小化
嗨露絲,
代碼很難優化以滿足您的需求。 對於那個很抱歉。
網站主持人對此評論進行了最小化
代碼不讀取兩位數的單元格編號,即 C10,請問這是為什麼
網站主持人對此評論進行了最小化
你好,水晶。 我試過這個公式,但它只報告第 9 行。我不會計算第 10 行及以後的數據。 比如我把上面的公式調整為統計A4中的單個點擊,報告給E5; A5向E5報告; A6 向 E6 報告,等等。總範圍是 A4 到 A17,總報告是 E4 到 E17。 你能幫忙嗎? 這是我使用的修改後的代碼。



私人子工作表_SelectionChange(ByVal Target As Range)
將 xRgArray 調暗為變體
暗x數
將 xStrR、xStrS、xStrD 調暗為字符串
將 xRgS、xRgD 調暗為範圍

將 xFNum 變暗
xRgArray = Array("A4,E4", "A5,E5", "A6,E6", "A7,E7", "A8,E8", "A9,E9", "A10,E10", "A11,E11 ", "A12,E12", "A13,E13", "A14,E14", "A15,E15", "A16,E16", "A17,E17")
在錯誤恢復下一頁
如果 Target.Cells.Count > 1 然後退出 Sub
對於 xFNum = LBound(xRgArray) 到 UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = 左(xStrR,2)
xStrD = ""
xStrD = 右(xStrR,2)
設置 xRgS = 無
設置 xRgS = Range(xStrS)
如果 TypeName(xRgS) <> "Nothing" 那麼
設置 xRgD = 無
設置 xRgD = Range(xStrD)
如果 TypeName(xRgD) <> "Nothing" 那麼
如果 TypeName(Intersect(xRgS, Target)) <> "Nothing" Then
xRgD.Value = xRgD.Value + 1
如果結束
如果結束
如果結束
下一頁
END SUB
網站主持人對此評論進行了最小化
嗨,JT,
感謝您的反饋意見。 原代碼有問題。 您可以嘗試以下新代碼。
這個謊言中的數字 4:Set xRight = Target.Offset(0, 4) 表示偏移到起始引用右側的 4 列(起始引用為 A4:A17)。 向右偏移 4 列後,結果會在 E4:E17 中輸出。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Extendoffice 20221010
    Dim xRight As Range

    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Range("A4:A17")) Is Nothing Then Exit Sub
    Set xRight = Target.Offset(0, 4)
    If TypeName(xRight.Value) = "Double" Then
        xRight.Value = xRight.Value + 1
    ElseIf TypeName(xRight.Value) = "Empty" Then
        xRight.Value = 1
    End If

End Sub
網站主持人對此評論進行了最小化
您好,有辦法支持我想要的任何數字的計數嗎? 例如:我點擊了 5 次,但我只想要 3 次。所以我將單元格中的數字更改為 3,當我再次點擊時,它會從 3 繼續。
感謝您的代碼!
網站主持人對此評論進行了最小化
嗨,
抱歉幫不了您,歡迎在我們的論壇上發布有關 Excel 的任何問題: https://www.extendoffice.com/forum.html. 您將從我們的專業人士或其他 Excel 粉絲那裡獲得更多 Excel 支持。
網站主持人對此評論進行了最小化
你好
Hay alguna manera de programar el conteo de clicks de acuerdo a la fecha, es decir programar varias celdas para que cuenten con la fecha del día?
網站主持人對此評論進行了最小化
您能否提供一個代碼,允許計算從 A2、B2 單元格到 A14、B14 單元格的點擊次數。 提前致謝。
網站主持人對此評論進行了最小化
嗨,芭芭拉,
您的意思是計算 A2:B14 範圍內的總點擊次數嗎? 或者點擊範圍 A2:B14 中的每個單元格?
網站主持人對此評論進行了最小化
Como zerar 是傳染病? 如何重置分數?
網站主持人對此評論進行了最小化
嗨,
如果要重置計數器,請在上面提供的原始代碼末尾添加以下 VBA 代碼,然後運行它。

子清除計數()
xRgD.Value = ""
x數 = 0
END SUB
網站主持人對此評論進行了最小化
嗨,我正在嘗試找到一種方法來計算點擊 20 個不同單元格的次數(每個單元格都應該單獨計算)。 我遇到了您的 VBA 代碼建議,試圖根據我的特定需求對其進行調整,但它不起作用。 你能告訴我應該如何編寫代碼嗎? 我要計數的單元格和值應該出現的單元格是:F12>AU12、F13>AU13、G12>AV12、G13>AV13、H10>AW10、H11>AW11、H12>AW12、H13>AW13 , H14>AW14, H15>AW15, I10>AX10, I11>AX11, I12>AX12, I13>AX13, I14>AX14, I15>AX15, J12>AY12, J13>AY13, K12>AZ12, K13>AZ13)。
這是我嘗試過但沒有成功的 VBA 代碼:

私人子工作表_SelectionChange(ByVal Target As Range)
將 xRgArray 調暗為變體
暗x數
將 xStrR、xStrS、xStrD 調暗為字符串
將 xRgS、xRgD 調暗為範圍

將 xFNum 變暗
xRgArray = Array("F12,AU12", "F13,AU13", "G12,AV12", "G13,AV13", "H10,AW10", "H11,AW11", "H12,AW12", "H13,AW13 ", "H14,AW14", "H15,AW15", "I10,AX10", "I11,AX11", "I12,AX12", "I13,AX13", "I14,AX14", "I15,AX15", "J12,AY12", "J13,AY13", "K12,AZ12", "K13,AZ13")
在錯誤恢復下一頁
如果 Target.Cells.Count > 1 然後退出 Sub
對於 xFNum = LBound(xRgArray) 到 UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = 左(xStrR,2)
xStrD = ""
xStrD = 右(xStrR,2)
設置 xRgS = 無
設置 xRgS = Range(xStrS)
如果 TypeName(xRgS) <> "Nothing" 那麼
設置 xRgD = 無
設置 xRgD = Range(xStrD)
如果 TypeName(xRgD) <> "Nothing" 那麼
如果 TypeName(Intersect(xRgS, Target)) <> "Nothing" Then
xRgD.Value = xRgD.Value + 1
如果結束
如果結束
如果結束
下一頁
END SUB

預先感謝您的幫助。
網站主持人對此評論進行了最小化
嗨,下面的代碼可以提供幫助。 請試一試。 謝謝你。 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
將 xRgS、xRgD 調暗為範圍
將 xStrRg 調暗為字符串
將 xFNum 調暗為整數
暗淡 xArr1, xArr2
如果 Target.Cells.Count > 1 然後退出 Sub
xStrRg = "F12-AU12; F13-AU13; G12-AV12; G13-AV13; H10-AW10; H11-AW11; H12-AW12; H13-AW13; H14-AW14; H15-AW15; I10-AX10; I11-AX11; I12-AX12; I13-AX13; I14-AX14; I15-AX15; J12-AY12; J13-AY13; K12-AZ12; K13-AZ13"
在錯誤恢復下一頁
xArr1 = 拆分(xStrRg,“;”)
對於 xFNum = 0 到 UBound(xArr1)
xArr2 = 拆分(xArr1(xFNum),“-”)
設置 xRgS = Range(xArr2(0))
設置 xRgD = Range(xArr2(1))
If Not (Intersect(xRgS, Target) is Nothing) 那麼
xRgD.Value = xRgD.Value + 1
如果結束
下一頁
END SUB
網站主持人對此評論進行了最小化
上面更正的代碼非常適合我正在使用的工作表,謝謝。 但是我有一個關於添加時間宏的問題,以便每天(不包括週末)計數移動到工作表中的下一行,例如:
第 3 行 - 7 年 1 月 2021 日 "B1-B3;C1-C3;D1-D3"第 4 行 - 7 年 2 月 2021 日 "B1-B4;C1-C4;D1-D4"第 5 行 - 7 年 3 月 2021 日“B1-B5;C1-C5;D1-D5”
網站主持人對此評論進行了最小化
Crystal,上面的代碼非常適合我正在使用的工作表,謝謝。 但是我有一個關於添加時間宏的問題,以便每天(不包括週末)計數移動到工作表中的下一行,例如:

第 3 行 - 7 年 1 月 2021 日“B1-B3;C1-C3;D1-D3”
第 4 行 - 7 年 2 月 2021 日“B1-B4;C1-C4;D1-D4”
第 5 行 - 7 年 3 月 2021 日“B1-B5;C1-C5;D1-D5”

如果這是可能的? 謝謝,肯
網站主持人對此評論進行了最小化
嗨,謝謝你提供這些 VBA 代碼,他們 幾乎 為我的需要工作。 我擔心我需要超過兩位數的事實意味著它不起作用。 我需要從 C8 到 C110,相應的計數是從 L8 到 L110。 你能幫我嗎? 提前謝謝了。
網站主持人對此評論進行了最小化
嗨安迪,下面的 VBA 代碼可以幫你一個忙。 請試一試。 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
將 xRgS、xRgD 調暗為範圍
將 xStrRg 調暗為字符串
將 xCStr、xVStr 調暗為字符串
將 xItem 調暗為整數
xCStr = "C8:C110" '要記錄每個單元格點擊次數的單元格範圍
xVStr = "L8:L110" '要放置記錄的單元格範圍
設置 xRgS = Range(xCStr)
設置 xRgD = Range(xVStr)
If Not (Intersect(xRgS, Target) is Nothing) 那麼
xItem = Target.Row - xRgS.Item(1).Row + 1
xRgD.Item(xItem).Value = xRgD.Item(xItem).Value + 1
如果結束
END SUB
網站主持人對此評論進行了最小化
有沒有辦法回溯數字計數? 例如:我點擊了 5 次,但我只想要 3 次。所以我將單元格中的數字更改為 3,當我再次點擊時,它會從 3 繼續。或者能夠按下另一個單元格並減少計數如果這更容易,則減 1。
網站主持人對此評論進行了最小化
您好,
j'aimerai comment je pourrais le nombre de clics sur les cellules D10 à M10 et le retrancrire à la ligne R10 et le faire pour toutes les lignes suivante donc compter les clics sur les cellules D11 à M11 et le transcrire à la ligne R11 等?

親切
網站主持人對此評論進行了最小化
嗨杜弗爾,
要計算從 D10 到 M10 的點擊次數並輸出 R10 中的總點擊次數,您可以應用以下 VBA 代碼來完成它。
備註:在代碼中,範圍“D10:M30" 表示該代碼僅適用於第 10 行到第 30 行,因此請指定您要計算的行數。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Extendoffice 20220609
    Dim xNum As Long
    Dim xRgCount, xRg As Range
    
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub

    Set xRg = Range("D10:M30")
    If Intersect(xRg, Target) Is Nothing Then Exit Sub
    Set xRgCount = Range("R" & Target.Row)
    
    If IsNumeric(xRgCount.Value) Then
        xNum = xRgCount.Value + 1
    Else
        xNum = 1
    End If
    xRgCount.Value = xNum
End Sub
網站主持人對此評論進行了最小化
你好。 Muchas gracias por los códigos。
Me gustaría saber cómo contar las veces que se hace clic sobre un enlace en una celda。
非常感謝。
網站主持人對此評論進行了最小化
嗨何塞瑪麗亞,
要計算超鏈接的點擊次數,您可以嘗試以下 VBA 代碼。
假設超鏈接在 A 列中,並且您希望在 B 列的相應單元格中填充點擊次數(如下面的屏幕截圖所示)
請將以下代碼放入工作表(代碼)窗口中。

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
'Updated by Extendoffice 20220805
    Dim Hyperlink As Range
    Set Hyperlink = Target.Range

    Hyperlink.Offset(0, 1) = Hyperlink.Offset(0, 1) + 1
End Sub

https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/clicks_on_a_hyperlink.png
這裡還沒有評論
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護