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

วิธีเพิ่มเครื่องหมายถูกในเซลล์ด้วยการดับเบิลคลิกใน Excel

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

ดับเบิลคลิกเพื่อเพิ่มเครื่องหมายถูกในเซลล์ด้วยรหัส VBA


ดับเบิลคลิกเพื่อเพิ่มเครื่องหมายถูกในเซลล์ด้วยรหัส VBA

รหัส VBA ต่อไปนี้สามารถช่วยคุณเพิ่มเครื่องหมายถูกในเซลล์ด้วยการดับเบิลคลิก กรุณาดำเนินการดังนี้

1. เปิดแผ่นงานที่คุณต้องการเพิ่มเครื่องหมายถูกลงในเซลล์จากนั้นคลิกขวาและเลือก ดูรหัส จากเมนูคลิกขวา

2 ใน Microsoft Visual Basic สำหรับแอปพลิเคชัน คัดลอกและวางโค้ด VBA ด้านล่างลงในไฟล์ รหัส หน้าต่าง

รหัส VBA: ดับเบิลคลิกเพื่อเพิ่มเครื่องหมายถูกในเซลล์

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("B1:B10")) Is Nothing Then
        Application.EnableEvents = False
        If ActiveCell.Value = ChrW(&H2713) Then
            ActiveCell.ClearContents
        Else
            ActiveCell.Value = ChrW(&H2713)
        End If
        Cancel = True
    End If
    Application.EnableEvents = True
End Sub

หมายเหตุ: ในรหัส B1: B10 คือช่วงที่คุณจะเพิ่มเครื่องหมายถูกเมื่อดับเบิลคลิก โปรดเปลี่ยนตามความต้องการของคุณ

3 กด อื่น ๆ + Q ปุ่มเพื่อปิดไฟล์ Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่างและกลับไปที่แผ่นงาน

ตอนนี้ดับเบิลคลิกที่เซลล์ใดก็ได้ในช่วง B1: B10 เครื่องหมายถูกจะถูกป้อนโดยอัตโนมัติ และดับเบิลคลิกที่เซลล์อีกครั้งเครื่องหมายถูกที่แทรกจะถูกลบออก

หากคุณจำเป็นต้องใช้เครื่องหมายถูกในงานประจำวันของ Excel เป็นประจำฉันขอแนะนำไฟล์ ข้อความอัตโนมัติ ยูทิลิตี้ของ Kutools สำหรับ Excel. ด้วยคุณสมบัตินี้คุณสามารถบันทึกเครื่องหมายถูกเป็นรายการข้อความอัตโนมัติจากนั้นจึงทำต่อในอนาคตด้วยการคลิกเพียงครั้งเดียวใน Excel ดังตัวอย่างด้านล่างที่แสดง
ดาวน์โหลดและทดลองใช้เลย! (เส้นทางฟรี 30 วัน)


บทความที่เกี่ยวข้อง:


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

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
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (11)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
como eu faço pra inserir a marca de seleção na célula, porém sem deletar o número que estiver digitado nela ou seja, a marca sairia na frente do número quando eu der duplo clique ando eu u u u u u u u u u u u กลุ่ม novamente ea célula voltaria ao normar (continuaria apenas o número).
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
โอลา ลุยซ์, tene essa alteracao. Ira funcionar nas celulas A2:A10 e D2:D5, เปลี่ยนแปลงตามความจำเป็น

ทาดาโอะ


แผ่นงานย่อยส่วนตัว_BeforeDoubleClick(ByVal กำหนดเป้าหมายเป็นช่วง ยกเลิกเป็นบูลีน)
ถ้าไม่ตัดกัน(Target, Union(Range("A2:A10"), Range("D2:D5"))) ก็ไม่มีอะไร
Application.EnableEvents = เท็จ
ถ้าเหลือ (ActiveCell.Value, 1) = ChrW(&H2713) แล้ว
ActiveCell.Value = ขวา (ActiveCell, Len (ActiveCell) - 1)
ActiveCell.การจัดแนวแนวนอน = xlRight
อื่น
ActiveCell.Value = ChrW(&H2713) & ActiveCell.Value
End If
ยกเลิก = จริง
End If
Application.EnableEvents = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
มีวิธีวนซ้ำรหัสนี้เพื่อให้อยู่ในแผ่นงานจำนวนมากในสมุดงานเดียวหรือไม่?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี leoflute หลังจากกด อื่น ๆ + F11 คีย์เพื่อเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน โปรดดับเบิลคลิก สมุดงานนี้ เพื่อเปิด ThisWorkbook (รหัส) หน้าต่าง แล้วคัดลอกรหัสด้านล่างลงในหน้าต่างรหัส อย่าลืมเปลี่ยนชื่อชีตและช่วงเซลล์ในโค้ด Private Sub Workbook_SheetBeforeDoubleClick (ByVal Sh As Object, ByVal Target As Range, ยกเลิกเป็นบูลีน)
'ปรับปรุงโดย Extendoffice 20201012
Dim xStrRg, xStrWs, xStrWsName เป็นสตริง
Dim xEEBol, xWSNBol, xBol เป็นบูลีน
Dim xArrWs
Dim xArrRg
Dim xI, xJ เป็นจำนวนเต็ม
Dim xWs เป็นเวิร์กชีต
Dim xRg เป็นช่วง

xStrWs = "แผ่นที่ 5 แผ่นที่ 1 แผ่นที่ 2" 'ชื่อแผ่นงานเฉพาะ
xStrRg = "B3: B10" 'ช่วงของเซลล์ที่คุณจะใส่เครื่องหมายถูก
xArrWs = แยก (xStrWs, ",")
xArrRg = แยก (xStrRg, ",")

xEEBol = Application.EnableEvents
Application.EnableEvents = เท็จ
เกี่ยวกับข้อผิดพลาดต่อไป
xStrWsName = ช.ชื่อ
xBol = เท็จ
xWSNBol = เท็จ
สำหรับ xI = 0 ถึง UBound(xArrWs)
ถ้า xStrWsName = xArrWs(xI) แล้ว
xWSNBol = จริง
ออกสำหรับ
End If
ถัดไป xI

ถ้า xWSNBol แล้ว
ตั้งค่า xWs = Application.Worksheets.Item(xArrWs(xI))
สำหรับ xJ = 0 ถึง UBound(xArrRg)
ตั้งค่า xRg = Sh.Range(xArrRg(xJ))
ถ้าไม่ตัดกัน (เป้าหมาย xRg) ก็ไม่มีอะไรทั้งนั้น
xBol = จริง
ออกสำหรับ
End If
ต่อไป xJ
End If

ถ้า xBol แล้ว
ถ้า ActiveCell.Value = ChrW(&H2713) แล้ว
ActiveCell.ClearContents
อื่น
ActiveCell.Value = ChrW(&H2713)
End If
ยกเลิก = จริง
End If
Application.EnableEvents = xEEBol
ย่อยสิ้นสุด

ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี! ฉันจะเพิ่มอะไรลงในโค้ดด้านบนเพื่อให้เซลล์เปลี่ยนสีเมื่อเพิ่มช่องกาเครื่องหมาย
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคริสตัล
มีวิธีทำเครื่องหมายใน A1:A10 พร้อมกับ B3:B10 หรือไม่?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันจะทำซ้ำหลายคอลัมน์ได้อย่างไร 
ตัวอย่างเช่นฉันต้องการในสิ่งต่อไปนี้:
E, F, I, J, M, N, Q, R, U, V, Y, Z, AC, AD, AG, AH, AK, AL, AO, AP, AS, AT, AW, AX
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Eu gostaria de saber se é possível adicionar a marca com apenas um clique ao invés de dois. มากกว่า
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ยูลิสเสส โนนาโต
ถ้าคุณต้องการเพิ่มเครื่องหมายถูกลงในเซลล์ด้วยการคลิกเมาส์เพียงครั้งเดียว โค้ด VBA ต่อไปนี้สามารถช่วยคุณได้
คุณต้องคลิก เมาส์ขวา ปุ่มเพื่อเปิดใช้งานรหัส
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    'Updated by Extendoffice 20220714
    If Not Intersect(Target, Range("B1:B10")) Is Nothing Then
        Application.EnableEvents = False
        If ActiveCell.Value = ChrW(&H2713) Then
            ActiveCell.ClearContents
        Else
            ActiveCell.Value = ChrW(&H2713)
        End If
        Cancel = True
    End If
    Application.EnableEvents = True
End Sub
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันจะทำให้เพิ่มการประทับเวลาในเซลล์ที่อยู่ติดกันหลังจากดับเบิลคลิกได้อย่างไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีโซระ
รหัส VBA ต่อไปนี้สามารถช่วยคุณได้ โปรดลองดู ขอขอบคุณ.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Updated by Extendoffice 20221125
    Dim xRight As Range
    Dim KeyCells As Range
    Set KeyCells = Range("B1:B10")
    Set xRight = Target.Offset(0, 1)
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        xRight.Value = Now()
    End If
Application.EnableEvents = True
End Sub
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ