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

Hogyan számolhatjuk az összes kattintást egy adott cellában az Excelben?

Ez a cikk az összes kattintás számlálásáról szól az Excel egy meghatározott cellájában.

Számolja meg az összes kattintást egy VBA kóddal ellátott cellában

Számolja meg az összes kattintást egy VBA kóddal ellátott cellában

Kérjük, tegye a következőket, hogy megszámolja az összes kattintást egy adott cellában az Excelben.

1. A munkalap tartalmazza azt a cellát, amelynek meg kell számlálnia annak összes kattintását, kattintson a jobb gombbal a lap fülére, majd kattintson Kód megtekintése a helyi menüből.

2. Ban,-ben Microsoft Visual Basic for Applications ablakba, kérjük, másolja és illessze be a VBA kód alatt a Kód ablakba.

VBA-kód: Számolja meg az összes kattintást egy adott cellában az Excel-ben

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

Megjegyzések: A kódban az E2 az a cella, amelyre meg kell számolni az összes kattintást, és H2 a számlálás kimeneti cellája. Kérjük, változtassa meg őket szükség szerint.

3. megnyomni a más + Q gombok a Microsoft Visual Basic for Applications ablak.

Mostantól, amikor a megadott munkalapon az E2 cellára kattint, az összes kattintás automatikusan feltöltődik a H2 cellában, az alábbi képernyőkép szerint. Például, ha ötször kattint az E2 cellára, akkor az H5 cellában megjelenik az 5. szám.

A legjobb irodai termelékenységi eszközök

Kutools for Excel Megoldja a legtöbb problémát, és 80%-kal növeli termelékenységét

  • újrafelhasználás: Gyorsan helyezze be összetett képletek, diagramok és bármi, amit korábban használt; Cellák titkosítása jelszóval; Levelezőlista létrehozása és e-maileket küldeni ...
  • Szuper Formula Bár (könnyedén szerkeszthet több szöveget és képletet); Olvasás elrendezés (könnyen olvasható és szerkeszthető nagyszámú cella); Beillesztés a Szűrt tartományba...
  • Cellák / sorok / oszlopok egyesítése az adatok elvesztése nélkül; Osztott cellák tartalma; Kombinálja a duplikált sorokat / oszlopokat... megakadályozza az ismétlődő cellákat; Hasonlítsa össze a tartományokat...
  • Válassza a Másolat vagy az Egyedi lehetőséget Sorok; Válassza az Üres sorok lehetőséget (az összes cella üres); Super Find és Fuzzy Find sok munkafüzetben; Véletlenszerű kiválasztás ...
  • Pontos másolás Több cella a képletreferencia megváltoztatása nélkül; Automatikus referenciák létrehozása több lapra; Helyezze be a golyókat, Jelölőnégyzetek és még sok más ...
  • Kivonat szöveg, Szöveg hozzáadása, Eltávolítás pozíció szerint, Hely eltávolítása; Hozz létre és nyomtasson személyhívó részösszegeket; Konvertálás a cellatartalom és a megjegyzések között...
  • Szuper szűrő (mentse el és alkalmazza a szűrősémákat más lapokra); Haladó rendezés hónap / hét / nap, gyakoriság és egyebek szerint; Speciális szűrő félkövér, dőlt betűvel ...
  • Kombinálja a munkafüzeteket és a munkalapokat; Táblázatok egyesítése kulcsoszlopok alapján; Az adatok felosztása több lapra; Kötegelt konvertálás xls, xlsx és PDF...
  • Több mint 300 hatékony funkció. Támogatja az Office / Excel 2007-2021 és 365 verziókat. Minden nyelvet támogat. Könnyű üzembe helyezés vállalatában vagy szervezetében. Teljes funkciók 30 napos ingyenes próbaverzió. 60 napos pénzvisszafizetési garancia.
kte lap 201905

Az Office fül a füles felületet hozza az Office-ba, és sokkal könnyebbé teszi a munkáját

  • Füles szerkesztés és olvasás engedélyezése Wordben, Excelben és PowerPointban, Publisher, Access, Visio és Project.
  • Több dokumentum megnyitása és létrehozása ugyanazon ablak új lapjain, mint új ablakokban.
  • 50% -kal növeli a termelékenységet, és naponta több száz kattintással csökkenti az egér kattintását!
officetab alja
A megjegyzések rendezése szerint
Régi az első
Újak előre
Hozzászólások (31)
Még nincs értékelés. Legyen Ön az első, aki értékel!
Dennis
Dennis
A weboldal moderátora ezt a megjegyzést minimalizálta
Hogyan lehet "resetelni" a számlálót?
Válasz
0
0
kristály-
kristály-     Dennis
A weboldal moderátora ezt a megjegyzést minimalizálta
Kedves Dennis!
Kérjük, adja hozzá az alábbi VBA-kódot az eredeti kód végéhez. Minden alkalommal, amikor ezt a kódot futtatja, a számlálás visszaáll 0-ra. Köszönjük megjegyzését.

Sub ClearCount()
xRgD.Value = ""
xNum = 0
End Sub
Válasz
Jelentés
0
0
Bev Wilson
Bev Wilson     kristály-
A weboldal moderátora ezt a megjegyzést minimalizálta
Kristály,

Meg tudod adni a teljes VBA kódot - ehhez? hogyan alkalmazhatnám egyetlen sorra – mindegyiknek saját számlálóra van szüksége?
Válasz
Jelentés
0
0
kristály-
kristály-     Bev Wilson
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia,
A teljes VBA kód a következő. Ha vissza szeretné állítani a számlálót, futtassa a második VBA-kódot. A kód egyetlen sorra való alkalmazása miatt sajnos még nem tudok segíteni.

„Az első VBA
Nyilvános xRgS, xRgD As Range
Nyilvános xNum As Long
Private Sub Worksheet_SelectionChange (ByVal Target as Range)
On Error Resume Next
Ha Target.Cells.Count > 1, akkor lépjen ki a Sub-ból
Set xRgS = Tartomány("E2")
Ha az xRgS semmi, akkor lépjen ki a Subból
xRgD beállítása = Tartomány("H2")
Ha az xRgD semmi, akkor lépjen ki a Subból
Ha az Intersect(xRgS, Target) semmi, akkor lépjen ki a Subból
xNum = xNum + 1
xRgD.Value = xNum
End Sub
– A második VBA
Sub ClearCount()
xRgD.Value = ""
xNum = 0
End Sub
Válasz
Jelentés
0
0
Guido
Guido
A weboldal moderátora ezt a megjegyzést minimalizálta
Köszönöm a kódot, nagyon hasznos.
Nem vagyok programozó, és szeretném tudni, hogyan lehet ezt a folyamatot kiterjeszteni minden sorra. Vagyis nemcsak E2>H2, hanem E3>H3, E4>H4 stb.
Van erre kód?


Előre is köszönöm!
Válasz
0
0
kristály-
kristály-     Guido
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Guido,

Az alábbi VBA kód segíthet a probléma megoldásában. Kérjük, próbálja meg. Köszönöm a hozzászólásod.
Private Sub Worksheet_SelectionChange (ByVal Target as Range)
Dim xRgArray As Variant
Dim xNum
Dim xStrR, xStrS, xStrD karakterláncként
Dim xRgS, xRgD As Range

Dim xFNum As Long
xRgArray = Tömb("E2,H2", "E3,H3", "E4,H4", "E5,H5", "E6,H6")
On Error Resume Next
Ha Target.Cells.count > 1, akkor lépjen ki a Sub-ból
xFNum esetén = LBound(xRgArray) – UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = Bal(xStrR, 2)
xStrD = ""
xStrD = jobb (xStrR, 2)
Set xRgS = Semmi
xRgS = Tartomány (xStrS) beállítása
Ha TypeName(xRgS) <> "Semmi" Akkor
Set xRgD = Semmi
xRgD beállítása = Tartomány(xStrD)
Ha TypeName(xRgD) <> "Semmi" Akkor
If TypeName(Intersect(xRgS, Target)) <> "Semmi" Akkor
xRgD.Érték = xRgD.Érték + 1
Ha véget
Ha véget
Ha véget
Következő
End Sub
Válasz
Jelentés
0
0
Ruth
Ruth     kristály-
A weboldal moderátora ezt a megjegyzést minimalizálta
Köszönet érte. Kipróbáltam és működött, de csak bizonyos számú celláig működött, hogyan tudjuk ezt a kódot kiterjeszteni a cellák végéig? például beírom ezt a kódot alább, és csak "G9,G9"-ig működik. Kösz


Private Sub Worksheet_SelectionChange (ByVal Target as Range)
Dim xRgArray As Variant
Dim xNum
Dim xStrR, xStrS, xStrD karakterláncként
Dim xRgS, xRgD As Range

Dim xFNum As Long
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")
On Error Resume Next
Ha Target.Cells.count > 1, akkor lépjen ki a Sub-ból
xFNum esetén = LBound(xRgArray) – UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = Bal(xStrR, 2)
xStrD = ""
xStrD = jobb (xStrR, 2)
Set xRgS = Semmi
xRgS = Tartomány (xStrS) beállítása
Ha TypeName(xRgS) <> "Semmi" Akkor
Set xRgD = Semmi
xRgD beállítása = Tartomány(xStrD)
Ha TypeName(xRgD) <> "Semmi" Akkor
If TypeName(Intersect(xRgS, Target)) <> "Semmi" Akkor
xRgD.Érték = xRgD.Érték + 1
Ha véget
Ha véget
Ha véget
Következő
End Sub
Válasz
0
0
kristály-
kristály-     Ruth
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Ruth,
A kódot nehéz úgy optimalizálni, hogy megfeleljen az Ön igényeinek. Sajnálom az esetet.
Válasz
Jelentés
0
0
dan
dan     kristály-
A weboldal moderátora ezt a megjegyzést minimalizálta
a kód nem olvas kétjegyű cellaszámot, azaz C10 miért van ez kérem
Válasz
0
0
JT
JT     kristály-
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Crystal. Kipróbáltam ezt a képletet, de csak a 9. sort jelenti. Nem számolom a 10. sort és tovább. Például a fenti képletet úgy állítottam be, hogy az egyes kattintásokat A4-ben számolja, az E5-re jelentsen; A5 az E5 felé jelenteni; A6 az E6-nak való jelentéshez stb. A teljes tartomány A4-től A17-ig, a teljes jelentés E4-től E17-ig terjed. Tudsz segíteni? Itt van az általam használt módosított kód.



Private Sub Worksheet_SelectionChange (ByVal Target as Range)
Dim xRgArray As Variant
Dim xNum
Dim xStrR, xStrS, xStrD karakterláncként
Dim xRgS, xRgD As Range

Dim xFNum As Long
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")
On Error Resume Next
Ha Target.Cells.Count > 1, akkor lépjen ki a Sub-ból
xFNum esetén = LBound(xRgArray) – UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = Bal(xStrR, 2)
xStrD = ""
xStrD = jobb (xStrR, 2)
Set xRgS = Semmi
xRgS = Tartomány (xStrS) beállítása
Ha TypeName(xRgS) <> "Semmi" Akkor
Set xRgD = Semmi
xRgD beállítása = Tartomány(xStrD)
Ha TypeName(xRgD) <> "Semmi" Akkor
If TypeName(Intersect(xRgS, Target)) <> "Semmi" Akkor
xRgD.Érték = xRgD.Érték + 1
Ha véget
Ha véget
Ha véget
Következő
End Sub
Válasz
0
0
kristály-
kristály-     JT
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia JT!
Köszönjük a visszajelzést. Valami hiba van az eredeti kódban. Kipróbálhatja a következő új kódot.
A 4-es szám ebben a hazugságban: Set xRight = Target.Offset(0, 4) azt jelenti, hogy 4 oszlopot kell eltolni a kezdő hivatkozástól jobbra (a kezdő hivatkozás A4:A17). 4 oszlop jobb oldali eltolása után az eredmények E4:E17-ben jelennek meg.
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
Válasz
Jelentés
0
0
Demetrius
Demetrius
A weboldal moderátora ezt a megjegyzést minimalizálta
Hello, van mód a számlálás visszaállítására bármilyen számra, amit akarok? Például: 5 kattintást tettem, de csak 3-at akartam. Így a cellában lévő számot 3-ra változtatom, és amikor újra kattintok, 3-ról folytatja.
Köszönöm a kódot!
Válasz
0
0
kristály-
kristály-     Demetrius
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia,
Sajnos ebben nem tudok segíteni, üdvözöljük, hogy az Excellel kapcsolatos kérdéseit felteheti fórumunkra: https://www.extendoffice.com/forum.html. További Excel-támogatást kaphat professzionális vagy más Excel-rajongóinktól.
Válasz
Jelentés
0
0
Andrew
Andrew
A weboldal moderátora ezt a megjegyzést minimalizálta
Helló
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?
Válasz
0
0
Barbara
Barbara
A weboldal moderátora ezt a megjegyzést minimalizálta
Tudna adni egy kódot, amely lehetővé teszi a kattintások számlálását A2, B2 celláktól A14, B14 cellákig. Előre is köszönöm.
Válasz
0
0
kristály-
kristály-     Barbara
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Barbara,
Úgy érted, hogy az A2:B14 tartományban számoljuk az összes kattintást? Vagy kattint az egyes cellákra az A2:B14 tartományban?
Válasz
Jelentés
0
0
Rennan Farias
Rennan Farias
A weboldal moderátora ezt a megjegyzést minimalizálta
Como zerar a contagem? Hogyan lehet visszaállítani a pontszámot?
Válasz
0
0
kristály-
kristály-     Rennan Farias
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia,
Ha vissza szeretné állítani a számlálót, adja hozzá az alábbi VBA-kódot a fent megadott eredeti kód végéhez, majd futtassa.

Sub ClearCount()
xRgD.Value = ""
xNum = 0
End Sub
Válasz
Jelentés
0
0
Yoni Weis324
Yoni Weis324
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Megpróbálom megszámolni, hogy hányszor kattintanak 20 különböző cellára (mindegyikét külön kell számolni). Találkoztam a VBA kódjavaslatoddal, megpróbáltam az én sajátos igényeimhez igazítani, de nem működik. tudtok tanácsot adni, hogyan kell a kódot írni? a cellákat, amiket meg akarok számolni, és amelyekben az értékeknek meg kell jelenniük: 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).
Ez a VBA kód, amit sikertelenül próbáltam:

Private Sub Worksheet_SelectionChange (ByVal Target as Range)
Dim xRgArray As Variant
Dim xNum
Dim xStrR, xStrS, xStrD karakterláncként
Dim xRgS, xRgD As Range

Dim xFNum As Long
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")
On Error Resume Next
Ha Target.Cells.Count > 1, akkor lépjen ki a Sub-ból
xFNum esetén = LBound(xRgArray) – UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = Bal(xStrR, 2)
xStrD = ""
xStrD = jobb (xStrR, 2)
Set xRgS = Semmi
xRgS = Tartomány (xStrS) beállítása
Ha TypeName(xRgS) <> "Semmi" Akkor
Set xRgD = Semmi
xRgD beállítása = Tartomány(xStrD)
Ha TypeName(xRgD) <> "Semmi" Akkor
If TypeName(Intersect(xRgS, Target)) <> "Semmi" Akkor
xRgD.Érték = xRgD.Érték + 1
Ha véget
Ha véget
Ha véget
Következő
End Sub

Előre is köszönöm a segítséget.
Válasz
Jelentés
0
0
kristály-
kristály-     Yoni Weis324
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Az alábbi kód segíthet. Kérjük, próbálja meg. Köszönöm. Private Sub Worksheet_SelectionChange (ByVal Target as Range)
Dim xRgS, xRgD As Range
Dim xStrRg As String
Dim xFNum As Integer
Dim xArr1, xArr2
Ha Target.Cells.Count > 1, akkor lépjen ki a Sub-ból
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"
On Error Resume Next
xArr1 = Felosztás(xStrRg, ";")
Ha xFNum = 0 - UBound(xArr1)
xArr2 = Felosztás(xArr1(xFNum), "-")
Beállítva xRgS = Tartomány(xArr2(0))
xRgD beállítása = Tartomány(xArr2(1))
Ha nem (Intersect(xRgS, Target) Is Nothing) Akkor
xRgD.Érték = xRgD.Érték + 1
Ha véget
Következő
End Sub
Válasz
Jelentés
0
0
Ken H.
Ken H.     kristály-
A weboldal moderátora ezt a megjegyzést minimalizálta
A fenti javított kód remek a laphoz, amivel dolgozom, köszönöm. De lenne egy kérdésem egy időmakró hozzáadásával kapcsolatban, hogy például minden nap (a hétvégék kivételével) a számláló a következő sorba kerüljön a lapon:
3. sor - 7. "B1-B2021; C1-C3; D1-D3" 1. sor - 3. "B4-B7; C2-C2021; D1-D4"1. sor - 4. "B1-B4; C5-C7; D3-D2021"
Válasz
0
0
KeHGC
KeHGC     kristály-
A weboldal moderátora ezt a megjegyzést minimalizálta
A Crystal, The Above kód nagyszerű a laphoz, amivel dolgozom, köszönöm. De lenne egy kérdésem egy időmakró hozzáadásával kapcsolatban, hogy például minden nap (a hétvégék kivételével) a számláló a következő sorba kerüljön a lapon:

3. sor – 7. "B1-B2021; C1-C3; D1-D3"
4. sor – 7. "B2-B2021; C1-C4; D1-D4"
5. sor – 7. "B3-B2021; C1-C5; D1-D5"

Ha ez lehetséges? thx, Ken
Válasz
Jelentés
0
0
Andy
Andy
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia! Köszönjük ezeket a VBA kódokat majdnem dolgozz az igényeim szerint. Attól tartok, hogy túl kell lépnem a két számjegyen, ez azt jelenti, hogy ez nem fog működni. C8-tól C110-ig kell rendelkeznem, és a megfelelő számnak L8-tól L110-ig kell lennie. Tud segíteni? Előre is köszönöm.
Válasz
0
0
kristály-
kristály-     Andy
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Andy! A következő VBA-kód jót tehet neked. Kérjük, próbálja meg. Private Sub Worksheet_SelectionChange (ByVal Target as Range)
Dim xRgS, xRgD As Range
Dim xStrRg As String
Dim xCStr, xVStr karakterláncként
Dim xItem As Integer
xCStr = "C8: C110" 'A cellák tartománya, amelyben rögzíteni szeretné az egyes cellák kattintásait
xVStr = "L8:L110" "A cellák tartománya a rekordok elhelyezéséhez
xRgS = Tartomány (xCStr) beállítása
xRgD beállítása = Tartomány(xVStr)
Ha nem (Intersect(xRgS, Target) Is Nothing) Akkor
xItem = Target.Row - xRgS.Item(1).Sor + 1
xRgD.Elem(xItem).Érték = xRgD.Elem(xItem).Érték + 1
Ha véget
End Sub
Válasz
Jelentés
0
0
Sid
Sid
A weboldal moderátora ezt a megjegyzést minimalizálta
Van mód a számok visszalépésére? Például: 5 kattintást tettem, de csak 3-at akartam. Tehát a cellában lévő számot 3-ra változtatom, és amikor újra kattintok, a 3-tól folytatódik. VAGY lehetőségem van egy másik cella megnyomására és a szám csökkentésére. 1-gyel, ha ez könnyebb.
Válasz
0
0
A SÜTŐBŐL
A SÜTŐBŐL
A weboldal moderátora ezt a megjegyzést minimalizálta
Szervusz,
j'aimerai comment je pourrais le nombre de clics sur les cellules D10 à M10 et le retranscrire à la ligne R10 et le faire pour toutes les lignes suivante donc compter les clics sur les cellules D11 à M11 à le transcrire ?

Üdvözlettel
Válasz
0
0
kristály-
kristály-     A SÜTŐBŐL
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia DUFOUR!
A kattintások számának D10-től M10-ig történő megszámlálásához és a kattintások teljes számának R10-ben történő kiadásához alkalmazza a következő VBA-kódot.
Megjegyzések: A kódban a tartomány "D10:M30" azt jelenti, hogy a kód csak a 10. sortól a 30. sorig működik, ezért kérjük, adja meg a számolni kívánt sorokat.
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
Válasz
Jelentés
0
0
Jose Maria
Jose Maria
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia. 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.
Köszönöm szépen.
Válasz
0
0
kristály-
kristály-     Jose Maria
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Jose Maria,
A hiperhivatkozásokra leadott kattintások számlálásához próbálkozzon a következő VBA-kóddal.
Tegyük fel, hogy a hiperhivatkozások az A oszlopban vannak, és azt szeretné, hogy a kattintások száma a B oszlop megfelelő cellájába kerüljön (ahogy az alábbi képernyőképen látható).
Kérjük, írja be a következő kódot a munkalap (kód) ablakba.

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
Válasz
Jelentés
0
0
Mehrdad
Mehrdad
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia.
köszönöm a csodálatos kódot.
Amikor ezt használom, a számláló minden alkalommal újraindul, amikor megnyitom a fájlt,
van valami megoldás erre a problémára?
nagyobb időablakban kell látnom a kattintások számát

thanks in advance
Válasz
Jelentés
0
0
kristály-
kristály-     Mehrdad
A weboldal moderátora ezt a megjegyzést minimalizálta
Szia Mehrdad,
Elnézést, hogy ilyen későn válaszolok. A következő kód segíthet a probléma megoldásában. Minden alkalommal, amikor megnyitja a fájlt, a számláló az utoljára számlált számtól kezdi el a számlálást.

Public xRgS, xRgD As Range
'Updated by Extendoffice 20230407
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 = xRgD.Value
    xNum = xNum + 1
    xRgD.Value = xNum
End Sub
Válasz
Jelentés
0
0
Még senki sem írt megjegyzést

Kövess minket

Copyright © 2009 - www.extendoffice.com. | Minden jog fenntartva. Powered by ExtendOffice. | Oldaltérkép
A Microsoft és az Office logó a Microsoft Corporation védjegyei vagy bejegyzett védjegyei az Egyesült Államokban és / vagy más országokban.
Sectigo SSL védi