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

วิธีการนับจำนวนครั้งที่เซลล์มีการเปลี่ยนแปลงใน Excel?

ในการนับจำนวนครั้งที่เซลล์ที่ระบุมีการเปลี่ยนแปลงใน Excel รหัส VBA ที่ให้ไว้ในบทความนี้สามารถช่วยได้

นับจำนวนครั้งที่เซลล์ถูกเปลี่ยนด้วยรหัส VBA


นับจำนวนครั้งที่เซลล์ถูกเปลี่ยนด้วยรหัส VBA

รหัส VBA ต่อไปนี้สามารถช่วยคุณนับจำนวนครั้งที่เซลล์ที่ระบุมีการเปลี่ยนแปลงใน Excel

1. ในเวิร์กชีตที่มีเซลล์อย่างน้อยหนึ่งเซลล์ที่คุณต้องการคำนวณการเปลี่ยนแปลงทั้งหมด ให้คลิกขวาที่แท็บแผ่นงาน แล้วคลิก ดูรหัส จากเมนูบริบท ดูภาพหน้าจอ:

2. ในการเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง คัดลอกและวางหนึ่งในรหัส VBA ต่อไปนี้ลงใน รหัส หน้าต่างตามความต้องการของคุณ

รหัส VBA 1: ติดตามการเปลี่ยนแปลงในเซลล์เดียวเท่านั้น

Dim xCount As Integer
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range, xCell As Range
    On Error Resume Next
    If Target = Range("B9") Then
        xCount = xCount + 1
        Range("C9").Value = xCount                                     
    End If
    Application.EnableEvents = False
    Set xRg = Application.Intersect(Target.Dependents, Me.Range("B9"))
    If Not xRg Is Nothing Then
        xCount = xCount + 1
        Range("C9").Value = xCount
    End If
    Application.EnableEvents = True
End Sub

หมายเหตุ: ในรหัส B9 คือเซลล์ที่คุณต้องนับการเปลี่ยนแปลงและ C9 คือเซลล์ที่จะเติมข้อมูลผลการนับ โปรดเปลี่ยนตามที่คุณต้องการ

รหัส VBA 2: ติดตามการเปลี่ยนแปลงหลายเซลล์ในคอลัมน์

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220916
    Dim xSRg As Range
    Dim xRRg As Range
    
    Set xSRg = Range("B9:B1000")
    Set xCell = Intersect(xSRg, Target)
    If xCell Is Nothing Then Exit Sub
    
    
    Application.EnableEvents = False
    On Error Resume Next
    Set xCell = xCell.Range("A1")
    Set xRRg = xCell.Offset(0, 1)
    
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
End Sub

หมายเหตุ: ในบรรทัดนี้ "ตั้งค่า xRRg = xCell.Offset(0, 1)", จำนวน 1 หมายถึงจำนวนคอลัมน์ที่จะออฟเซ็ตทางด้านขวาของการอ้างอิงเริ่มต้น (ที่นี่การอ้างอิงเริ่มต้นคือ column Bและจำนวนที่คุณต้องการส่งคืนอยู่ในคอลัมน์ C ซึ่งอยู่ถัดจากคอลัมน์ B) หากคุณต้องการแสดงผลลัพธ์ในคอลัมน์ S, เปลี่ยนเบอร์ 1 ไปยัง 10.

จากนี้ไป เมื่อเซลล์ B9 หรือเซลล์ใดๆ ในช่วง B9:B1000 เปลี่ยนแปลง จำนวนการเปลี่ยนแปลงทั้งหมดจะถูกซ้อนทับและเติมลงในเซลล์ที่ระบุโดยอัตโนมัติ


เครื่องมือเพิ่มประสิทธิภาพการทำงานในสำนักงานที่ดีที่สุด

Kutools สำหรับ Excel ช่วยแก้ปัญหาส่วนใหญ่ของคุณและเพิ่มผลผลิตของคุณได้ถึง 80%

  • นำมาใช้ใหม่: ใส่อย่างรวดเร็ว สูตรที่ซับซ้อนแผนภูมิ และสิ่งที่คุณเคยใช้มาก่อน เข้ารหัสเซลล์ ด้วยรหัสผ่าน; สร้างรายชื่อผู้รับจดหมาย และส่งอีเมล ...
  • ซุปเปอร์ฟอร์มูล่าบาร์ (แก้ไขข้อความและสูตรหลายบรรทัดได้อย่างง่ายดาย); การอ่านเค้าโครง (อ่านและแก้ไขเซลล์จำนวนมากได้อย่างง่ายดาย); วางลงในช่วงที่กรองแล้ว...
  • ผสานเซลล์ / แถว / คอลัมน์ โดยไม่สูญเสียข้อมูล แยกเนื้อหาของเซลล์ รวมแถว / คอลัมน์ที่ซ้ำกัน... ป้องกันเซลล์ซ้ำ; เปรียบเทียบช่วง...
  • เลือกซ้ำหรือไม่ซ้ำ แถว; เลือกแถวว่าง (เซลล์ทั้งหมดว่างเปล่า); Super Find และ Fuzzy Find ในสมุดงานจำนวนมาก สุ่มเลือก ...
  • สำเนาถูกต้อง หลายเซลล์โดยไม่เปลี่ยนการอ้างอิงสูตร สร้างการอ้างอิงอัตโนมัติ ถึงหลายแผ่น ใส่สัญลักษณ์แสดงหัวข้อย่อย, กล่องกาเครื่องหมายและอื่น ๆ ...
  • แยกข้อความ, เพิ่มข้อความ, ลบตามตำแหน่ง, ลบ Space; สร้างและพิมพ์ผลรวมย่อยของเพจ แปลงระหว่างเนื้อหาของเซลล์และความคิดเห็น...
  • ซุปเปอร์ฟิลเตอร์ (บันทึกและใช้โครงร่างตัวกรองกับแผ่นงานอื่น ๆ ); การเรียงลำดับขั้นสูง ตามเดือน / สัปดาห์ / วันความถี่และอื่น ๆ ตัวกรองพิเศษ โดยตัวหนาตัวเอียง ...
  • รวมสมุดงานและแผ่นงาน; ผสานตารางตามคอลัมน์สำคัญ แยกข้อมูลออกเป็นหลายแผ่น; Batch แปลง xls, xlsx และ PDF...
  • คุณสมบัติที่ทรงพลังมากกว่า 300 รายการ. รองรับ Office / Excel 2007-2019 และ 365 รองรับทุกภาษา ใช้งานง่ายในองค์กรหรือองค์กรของคุณ ทดลองใช้ฟรี 30 วันเต็ม รับประกันคืนเงิน 60 วัน
kte แท็บ 201905

แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก

  • เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
  • เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
  • เพิ่มผลผลิตของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
ด้านล่าง officetab
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (20)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณมาก ! มันใช้งานได้ดี

แต่คุณจะได้รับฟังก์ชัน/กฎเดียวกันเพื่อทำงานกับช่วงของเซลล์ได้อย่างไร ตลอดทั้งคอลัมน์ เป็นต้น

ฉันมีรายชื่อผู้ติดต่อของธุรกิจฉันในแถวต่างๆ โดยมีรายละเอียดการติดต่อในคอลัมน์ต่างๆ และฉันต้องการเพิ่มคอลัมน์ที่ลงทะเบียนและนับจำนวนครั้งที่มีการเปลี่ยนแปลงเซลล์ที่กำหนดในแต่ละแถว รหัสที่คุณให้นั้นใช้งานได้ดี แต่สำหรับเซลล์ครั้งละหนึ่งเซลล์เท่านั้น !

ฉันเพิ่งเริ่มใช้ VBA ดังนั้นฉันจึงขอขอบคุณสำหรับการสนับสนุนของคุณ

ฉันพยายามเพิ่มช่วงของเซลล์ลงในโค้ด ดังนั้นแทนที่จะใช้ "B9" และ "C9" ตามที่ให้ไว้ในตัวอย่างข้างต้น ฉันลองเล่นกับรูปแบบต่างๆ เช่น "B:B", "C:C" หรือ "B9" :B1000" และ "C9:C1000" ไม่สำเร็จ

ขอบคุณล่วงหน้า
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีแจน
โปรดลองใช้โค้ด VBA ด้านล่าง หวังว่ามันจะช่วยได้ ขอบคุณสำหรับความคิดเห็นของคุณ

Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
Dim xRg เป็นช่วง xCell เป็นช่วง
Dim xSRg, xRRg เป็นช่วง
Dim xFNum นานเท่านาน

ตั้งค่า xSRg = ช่วง ("B9:B1000")
ตั้งค่า xRRg = ช่วง ("C9:C1000")

Application.EnableEvents = เท็จ
เกี่ยวกับข้อผิดพลาดต่อไป
สำหรับ xFNum = 1 ถึง xSRg.count
ถ้าเป้าหมาย = xSRg.Item(xFNum) แล้ว
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).ค่า + 1
Application.EnableEvents = จริง
ออกจาก Sub
End If
ถัดไป xFNum
Application.EnableEvents = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคริสตัล

นี่ยอดเยี่ยมมาก บนเมทริกซ์ของฉัน ฉันใช้สิ่งนี้กับคอลัมน์ใดคอลัมน์หนึ่ง แต่ฉันพยายามที่จะทำซ้ำสิ่งนี้ในหลายคอลัมน์ คุณมีทางออกหรือไม่?

ขอบคุณล่วงหน้า
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณช่วยระบุชุดรหัสทั้งหมดได้ไหม ฉันถือว่ารหัสของ Crystal ถูกรวมเข้ากับรหัสอื่นหรือไม่ ขอบคุณ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคริสตัล

ฉันมีปัญหากับรหัส ถ้าเซลล์เช่น ถ้าฉันป้อน

B9 เป็น "Apple" จากนั้นจะเพิ่ม C9 ขึ้น 1
B10 เป็น "บอล" จากนั้นจะเพิ่ม C10 ขึ้น 1
แต่ถ้าฉันเข้า
B11 เป็น "Apple" อีกครั้ง C9 จะเพิ่มขึ้น 1 ไม่ใช่ C11

ดูเหมือนว่าจะเพิ่มแถวโดยมีค่าเกิดขึ้นครั้งแรก ไม่ใช่แถวที่แก้ไขจริง

มีวิธีเพิ่มเซลล์ในแถวเดียวกันและไม่ใช่แถวก่อนหน้าหรือไม่

ขอบคุณ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณคิดออกไหม ฉันก็สนใจที่จะตรวจสอบหลายเซลล์เช่นกัน ยังไม่ได้ลอง
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เควินสวัสดี,

รหัสต่อไปนี้สามารถช่วยคุณแก้ปัญหาได้ ขอบคุณสำหรับความคิดเห็นของคุณ
Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
Dim xRg เป็นช่วง xCell เป็นช่วง
Dim xSRg, xRRg เป็นช่วง
Dim xFNum นานเท่านาน

ตั้งค่า xSRg = ช่วง ("B9:B1000")
ตั้งค่า xRRg = ช่วง ("C9:C1000")

Application.EnableEvents = เท็จ
เกี่ยวกับข้อผิดพลาดต่อไป
สำหรับ xFNum = 1 ถึง xSRg.count
ถ้าเป้าหมาย = xSRg.Item(xFNum) แล้ว
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).ค่า + 1
Application.EnableEvents = จริง
ออกจาก Sub
End If
ถัดไป xFNum
Application.EnableEvents = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Gracias de antemano por el aporte, muy útil, sin embargo, quisiera pedir su ayuda a fin de reiniciar el contador a cero cuando sea necesario, es decir, luego de contar las veces que se modificó la celda, a cero โคเมนซาร์ podrás ayudarme. กราเซียส!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Hello All,

วิธีแก้ปัญหาตามที่ระบุไว้ใน "นับจำนวนครั้งที่เซลล์ถูกเปลี่ยนด้วยรหัส VBA" นั้นดีหากเราติดตามการเปลี่ยนแปลงในเซลล์เดียวเท่านั้น โปรดแนะนำว่าจำเป็นต้องแก้ไขอะไร หากต้องการติดตามหลายเซลล์ ในกรณีที่มีหลายเซลล์ ตัวนับที่เพิ่มขึ้นควรปรากฏถัดจากเซลล์ที่มีการติดตามการเปลี่ยนแปลงค่า
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
รอคอยความช่วยเหลือและความช่วยเหลือเพื่อให้มีรหัส VBA เฉพาะ ซึ่งสามารถนำไปใช้กับหลายเซลล์ในแผ่นงานเดียว
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ชิจู
โปรดลองใช้โค้ด VBA ด้านล่าง ขอบคุณสำหรับความคิดเห็น

Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
Dim xRg เป็นช่วง xCell เป็นช่วง
Dim xSRg, xRRg เป็นช่วง
Dim xFNum นานเท่านาน

ตั้งค่า xSRg = ช่วง ("B9:B1000")
ตั้งค่า xRRg = ช่วง ("C9:C1000")

Application.EnableEvents = เท็จ
เกี่ยวกับข้อผิดพลาดต่อไป
สำหรับ xFNum = 1 ถึง xSRg.count
ถ้าเป้าหมาย = xSRg.Item(xFNum) แล้ว
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).ค่า + 1
Application.EnableEvents = จริง
ออกจาก Sub
End If
ถัดไป xFNum
Application.EnableEvents = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ทีม,

เมื่อฉันลองใช้:

Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
Dim xRg เป็นช่วง xCell เป็นช่วง
Dim xSRg, xRRg เป็นช่วง
Dim xFNum นานเท่านาน

ตั้งค่า xSRg = ช่วง ("B9:B1000")
ตั้งค่า xRRg = ช่วง ("C9:C1000")

เปลี่ยนช่วงและเซลล์เป้าหมายอย่างระมัดระวังด้วย P2:P200 และ X2:X200 ตามลำดับ ฉันไม่นับการเปลี่ยนแปลงในคอลัมน์ X แม้ว่าฉันจะพยายามเปลี่ยนเซลล์ในหลายแถวใน P2:P200

ความช่วยเหลือใด ๆ ที่จะได้รับการชื่นชมอย่างมาก.

ความนับถือ
JT
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ใครช่วยฉันให้บรรลุการเข้ารหัสสำหรับการนับเวลาที่เซลล์ถูกเปลี่ยนเป็น "ตรวจสอบใหม่" และสามารถใช้กับการเข้าของคอลัมน์ได้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Quisiera que me ayudaran a reiniciar el contador a cero cuando lo requiera, es decir, la celda c9 llevarla a cero y comenzar a contar b9 นูวาเมนเต
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี FELIX MARIÑO
โปรดเพิ่มรหัสต่อไปนี้หลังรหัสที่ให้ไว้ในโพสต์นี้ เมื่อคุณต้องการรีเซ็ตเซลล์ ให้คลิกที่คำใดๆ ในโค้ด จากนั้นกดปุ่ม F5 เพื่อเรียกใช้
Sub CleaRCount()
'Updated by Extendoffice 20220527
    xCount = 0
    Range("c9") = 0
End Sub
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคริสตัล

ฉันมีปัญหาเดียวกันกับ RedDragon ฉันกำลังพยายามติดตามการเปลี่ยนแปลงวันที่ เช่น เมื่อตัวแทนส่งกรณีไปยังผู้จัดการ พวกเขาป้อนวันที่ด้วยตนเอง ซึ่งอาจเกิดขึ้นได้มากกว่าหนึ่งครั้ง ในกรณีนี้ ฉันจึงพยายามใช้รหัสนี้เพื่อแสดงจำนวนครั้งที่แต่ละกรณีมี ถูกส่งไปยังผู้จัดการ ปัญหาของฉันคือ:

1) ถ้าหลายกรณีถูกส่งไปยังผู้จัดการในหนึ่งวัน ตัวนับจะเพิ่มขึ้นเฉพาะในอินสแตนซ์แรกของวันที่นั้น ไม่ใช่ถัดจากแถวที่เป็นปัญหา
2) ทุกครั้งที่ฉันออกจากแผ่นงาน เปิดใหม่อีกครั้ง และแก้ไขวันที่ ตัวนับจะรีเซ็ตเป็น "1" ฉันจะรับค่านี้ไปได้อย่างไรและไม่รีเซ็ตเมื่อเปิดแผ่นงานอีกครั้ง

ความช่วยเหลือใด ๆ ที่ชื่นชมอย่างมากและขอบคุณมากสำหรับสิ่งที่คุณได้ทำมาจนถึงตอนนี้

กาดจุส
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคุณ Gadjus
ขออภัยในความไม่มั่นใจ รหัส VBA ต่อไปนี้สามารถช่วยคุณได้ กรุณาให้มันลอง

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220916
    Dim xSRg As Range
    Dim xRRg As Range
    
    Set xSRg = Range("B9:B1000")
    Set xCell = Intersect(xSRg, Target)
    If xCell Is Nothing Then Exit Sub
    
    
    Application.EnableEvents = False
    On Error Resume Next
    Set xCell = xCell.Range("A1")
    Set xRRg = xCell.Offset(0, 1)
    
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
End Sub
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันลองใช้โค้ดด้านล่างแล้วใช้งานได้ แต่ฉันใช้เพื่อติดตามการเปลี่ยนแปลงในวันที่ เนื่องจากบางวันที่จะเหมือนเดิมทุกครั้งที่ฉันเปลี่ยนวันที่ที่เหมือนกันกับวันที่อื่นในคอลัมน์ ระบบจะนับอีกครั้ง
ฉันลองใช้รหัสล่าสุดแต่มันไม่ทำอะไรเลยเมื่อฉันลอง ขอบคุณสำหรับรหัสที่ดีนี้!

Worksheet_Change ย่อยส่วนตัว (เป้าหมายเป็นช่วง ByVal)
Dim xRg เป็นช่วง xCell เป็นช่วง
Dim xSRg, xRRg เป็นช่วง
Dim xFNum นานเท่านาน

ตั้งค่า xSRg = ช่วง ("I3:I1000")
ตั้งค่า xRRg = ช่วง ("S3:S1000")

Application.EnableEvents = เท็จ
เกี่ยวกับข้อผิดพลาดต่อไป
สำหรับ xFNum = 1 ถึง xSRg.Count
ถ้าเป้าหมาย = xSRg.Item(xFNum) แล้ว
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).ค่า + 1
Application.EnableEvents = จริง
ออกจาก Sub
End If
ถัดไป xFNum
Application.EnableEvents = จริง
ย่อยสิ้นสุด
ย่อย ClearRCount()
'ปรับปรุงโดย Extendoffice 20220527
xCount = 0
ช่วง("S3") = 0
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี
รหัส VBA ต่อไปนี้สามารถช่วยคุณได้ กรุณาให้มันลอง
หมายเหตุ: ในบรรทัดนี้ "ตั้งค่า xRRg = xCell.Offset(0, 10)", จำนวน "10” หมายถึงจำนวนคอลัมน์ที่จะออฟเซ็ตทางด้านขวาของการอ้างอิงเริ่มต้น (ที่นี่การอ้างอิงเริ่มต้นคือคอลัมน์ Iและจำนวนที่คุณต้องการส่งคืนอยู่ในคอลัมน์ S).

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220919
    Dim xSRg As Range
    Dim xRRg As Range
    
    Set xSRg = Range("I3:I1000")
    Set xCell = Intersect(xSRg, Target)
    If xCell Is Nothing Then Exit Sub
    
    
    Application.EnableEvents = False
    On Error Resume Next
    Set xCell = xCell.Range("A1")
    Set xRRg = xCell.Offset(0, 10)
    
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
End Sub
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณ Crystal ใช้งานได้ดีมาก!
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ