คลิกที่เซลล์A1แล้วเซลล์B1เติมสีพื้นหลังอัตโนมัติ

[kio2002]

เรียนสมาชิกทุกท่านครับ

ขอเล่าความต้องการก่อนนะครับ
พอดีผมต้องการให้เซลล์B1เติมสีอัตโนมัติ เมื่อใช้เมาส์คลิกที่เซลล์A1
โดยกำหนดให้เซลล์A1มีค่าว่าง เซลล์B1ถึงจะเติมสีพื้นหลัง
และถ้าหากไม่ได้คลิกที่เซลล์A1(คลิกเลือกที่เซลล์อื่น) เซลล์B1ไม่ต้องเติมสี

ปัญหาที่ติดตอนนี้คือ
เวลาใช้เมาส์คลิกที่เซลล์A1แล้วB1จะถูกเลือกอัตโนมัติเลย
แต่ผมต้องการคือ ให้เติมสีพื้นหลังที่เซลล์B1เท่านั้น โดยที่เซลล์A1ยังถูกเลือกอยู่เหมือนเดิม
และถ้าหากเราคลิกเลือกที่เซลล์อื่น อยากให้เซลล์B1ไม่ต้องเติมสีพื้นหลัง

รบกวนทุกท่านช่วยปรับcodeให้หน่อยครับ

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = Range("A1").Address Then
        If Range("A1").Value = "" Then
        Range("B1").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
            .PatternTintAndShade = 0
            End With
        End If
    End If
End Sub

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = Range("A1").Address And Range("A1").Value = "" Then
            Range("B1").Interior.Color = 255
    End If
End Sub

[kio2002]

ตัวอย่าง Code ครับ

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = Range("A1").Address And Range("A1").Value = "" Then
            Range("B1").Interior.Color = 255
    End If
End Sub

เซลล์B1เติมสีให้อัตโนมัติตามต้องการแล้วครับ
แต่ยังติดตรงที่ ถ้าเราคลิกเลือกเซลล์อื่นๆที่ไม่ใช่เซลล์A1
อยากให้เซลล์B1ไม่ต้องเติมสีพื้นหลัง หรือกลับมาเป็นสีขาวเหมือนเดิม

[puriwutpokin]

ปรับเป็น

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = Range("A1").Address And Range("A1").Value = "" Then
            Range("B1").Interior.Color = 255
            Else
            Range("B1").Interior.Color = xlNone
    End If
End Sub
 

[kio2002]

นำcodeของคุณpuriwutpokinไปใช้แล้วตรงตามที่ต้องการแล้วครับ

แต่จะปรับcodeตรงนี้เพิ่มเติมครับ
โดยที่ไม่ต้องสนใจว่าเซลล์A1จะมีค่าอะไรก็ตาม แค่คลิกที่เซลล์A1 แล้วก็เติมสีอัตโนมัติที่เซลล์B1เลย
If Target.Address = Range("A1").Address And Range("A1").select

[puriwutpokin]

ปรับเป็น

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = Range("A1").Address Then
            Range("B1").Interior.Color = 255
            Else
            Range("B1").Interior.Color = xlNone
    End If
End Sub
 

[kio2002]

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

Code: Select all

If Target.Address = Range("A1").Address Then
            Range("B1").Interior.Color = 255
            Else
            Range("B1").Interior.Color = xlNone
    End If
    If Target.Address = Range("A2").Address Then
            Range("B2").Interior.Color = 255
            Else
            Range("B2").Interior.Color = xlNone
    End If

[snasui]

ตัวอย่าง Code

Code: Select all

Range("b:b").Interior.Color = xlNone
If Not Intersect(Target, Range("a1:a50")) Is Nothing Then
    Target.Offset(0, 1).Interior.Color = 255
End If

[kio2002]

สุดยอดไปเลย code ตรงตามที่การแล้วครับ
ขอบคุณคนควน และสมาชิกทุกๆคนนะครับ
เว็บนี้มีประโยชน์อย่างมากเลย