รบกวนขอ Code VBA ที่เหมือนคำสั่ง Vlookup หน่อยครับ

[snasui]

ผมเขียน Countif สำหรับตรวจสอบค่าซ้ำสับตำแหน่ง ที่ถูกเป็นตามตามด้านล่างครับ

Code: Select all

If Application.CountIf(rCheck, Target) > 1 Then
    MsgBox ("Double!!!")
End If

[akung]

มันจะดึงข้อมูลมาให้ได้ก็ต่อเมื่อค่าที่คีย์เป็นประเภทเดียวกัน เช่นเป็นตัวเลขเหมือนกัน เป็น Text เหมือนกัน จากไฟล์ที่แนบมาได้กำหนดให้เป็น Text แต่ต้นทางเป็น Number ครับ การ Lookup และการ Match ต้องคำนึงถึงสิ่งเหล่านี้เป็นลำดับแรกเสมอจะลืมไม่ได้ครับ

ผมปรับเป็น Numberic แล้วครับ ผมก็คิดว่าน่าจะเป็นจุดนี้เหมือนกันเลยไปปรับให้ตรงกันคือเป็น Numberic แต่พอแก้แล้วก็ไม่มาครับ ลองเช็ค Code มันก็วิ่งไปทำงานนะครับ แต่ไม่มา

[akung]

ผมเขียน Countif สำหรับตรวจสอบค่าซ้ำสับตำแหน่ง ที่ถูกเป็นตามตามด้านล่างครับ

Code: Select all

If Application.CountIf(rCheck, Target) > 1 Then
    MsgBox ("Double!!!")
End If

1 Then
MsgBox (

ต้องสำหรับตรงไหนครับอาจารย์

[snasui]

ในโพสต์นี้ครับ viewtopic.php?p=21211#p21211

[akung]

ในโพสต์นี้ครับ viewtopic.php?p=21211#p21211

ไม่เข้าใจครับอาจารย์

ผมจะต้องสลับ code นี้ ตรงไหนอย่างไรครับ ผมไม่เข้าใจครับอาจารย์

Code: Select all

If Application.CountIf(rCheck, Target) > 1 Then
    MsgBox ("Double!!!")
End If

[snasui]

ลองดูส่วนประกอบใน Countif ครับ จะเห็นว่ามันวางสับตำแหน่งกัน ให้ใช้อันหลังนี้ไปแทนอันเดิมครับ

สำหรับด้านล่างคือ Code ที่ผมปรับเพิ่มเติมโดยเอาการดักค่าผิดพลาดออกไป

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    Dim rCheck As Range
    Dim ColAmount As Integer
    Dim ColName As Integer
    Dim lng As Long
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 1 Then
        With Sheets("Sheet2")
            Set rCheck = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
        End With
        With Sheets("Sheet1")
            Set Rng = .Range("A1", .Range("C" & Rows.Count).End(xlUp))
        End With
        ColName = 2
        ColAmount = 3
        lng = Application.CountIf(Rng.Resize(, 1), Target)
        If lng >= 1 Then
            If Application.CountIf(rCheck, Target) > 1 Then
                MsgBox ("Double!!!")
            End If
            Target.Offset(0, 2) = Application.VLookup(Target, Rng, ColAmount, 0)
            Target.Offset(0, 1) = Application.VLookup(Target, Rng, ColName, 0)
        Else
             Target.Font.Color = vbRed
             Target.Font.Bold = True
        End If
    End If
End Sub

[akung]

ลองดูส่วนประกอบใน Countif ครับ จะเห็นว่ามันวางสับตำแหน่งกัน ให้ใช้อันหลังนี้ไปแทนอันเดิมครับ

สำหรับด้านล่างคือ Code ที่ผมปรับเพิ่มเติมโดยเอาการดักค่าผิดพลาดออกไป

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    Dim rCheck As Range
    Dim ColAmount As Integer
    Dim ColName As Integer
    Dim lng As Long
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 1 Then
        With Sheets("Sheet2")
            Set rCheck = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
        End With
        With Sheets("Sheet1")
            Set Rng = .Range("A1", .Range("C" & Rows.Count).End(xlUp))
        End With
        ColName = 2
        ColAmount = 3
        lng = Application.CountIf(Rng.Resize(, 1), Target)
        If lng >= 1 Then
            If Application.CountIf(rCheck, Target) > 1 Then
                MsgBox ("Double!!!")
            End If
            Target.Offset(0, 2) = Application.VLookup(Target, Rng, ColAmount, 0)
            Target.Offset(0, 1) = Application.VLookup(Target, Rng, ColName, 0)
        Else
             Target.Font.Color = vbRed
             Target.Font.Bold = True
        End If
    End If
End Sub

เข้าใจแล้วครับ

แต่พอ Run แล้วก็ Error ตรง 4 บรรทัดนี้ครับ คาดว่าน่าจะเกี่ยวกับคำว่า Target ครับ เราต้องประกาศตัวแปรอะไรให้มันหรือเปล่าครับ
If Target.Count > 1 Then Exit Sub
If Target.Column = 1 Then
Target.Font.Color = vbRed
Target.Font.Bold = True

[snasui]

Code นี้เป็นการ Check Event ว่าเมื่อเซลล์ในคอลัมน์ A มีการเปลี่ยนแปลงก็ให้ทำงาน คำว่า Target คือเซลล์ใด ๆ ที่เปลี่ยนแปลง ไม่จำเป็นต้องประกาศตัวแปรเพิ่ม เนื่องจากโปรแกรมรับค่ามาจากเหตุการณ์ที่ไปกระทำกับเซลล์และได้ประกาศไว้เรียบร้อยแล้ว นั่นคือตามด้านล่าง ซึ่งเป็นการประกาศต่อท้ายชื่อของ Procedure

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)

และ Code จะถูกวางอยู่ในชีทที่เราต้องการใช้ดักการเปลี่ยนแปลงในเซลล์ เมื่อวางถูกที่แล้วแต่ยังทำงานไม่ได้ ผมก็คงช่วยได้เท่านี้ครับ เพราะในเครื่องผมทำงานได้เป็นปกติทุกประการ

[akung]

Code นี้เป็นการ Check Event ว่าเมื่อเซลล์ในคอลัมน์ A มีการเปลี่ยนแปลงก็ให้ทำงาน คำว่า Target คือเซลล์ใด ๆ ที่เปลี่ยนแปลง ไม่จำเป็นต้องประกาศตัวแปรเพิ่ม เนื่องจากโปรแกรมรับค่ามาจากเหตุการณ์ที่ไปกระทำกับเซลล์และได้ประกาศไว้เรียบร้อยแล้ว นั่นคือตามด้านล่าง ซึ่งเป็นการประกาศต่อท้ายชื่อของ Procedure

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)

และ Code จะถูกวางอยู่ในชีทที่เราต้องการใช้ดักการเปลี่ยนแปลงในเซลล์ เมื่อวางถูกที่แล้วแต่ยังทำงานไม่ได้ ผมก็คงช่วยได้เท่านี้ครับ เพราะในเครื่องผมทำงานได้เป็นปกติทุกประการ

เข้าใจแล้วครับ

เดี่ยวผมจะลองงม ๆ ไปเรื่อย ๆ ก่อนครับ

แค่นี้ก็รบกวนอาจารย์มากแล้วครับ ขอบคุณครับผม

[akung]

Code นี้เป็นการ Check Event ว่าเมื่อเซลล์ในคอลัมน์ A มีการเปลี่ยนแปลงก็ให้ทำงาน คำว่า Target คือเซลล์ใด ๆ ที่เปลี่ยนแปลง ไม่จำเป็นต้องประกาศตัวแปรเพิ่ม เนื่องจากโปรแกรมรับค่ามาจากเหตุการณ์ที่ไปกระทำกับเซลล์และได้ประกาศไว้เรียบร้อยแล้ว นั่นคือตามด้านล่าง ซึ่งเป็นการประกาศต่อท้ายชื่อของ Procedure

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)

และ Code จะถูกวางอยู่ในชีทที่เราต้องการใช้ดักการเปลี่ยนแปลงในเซลล์ เมื่อวางถูกที่แล้วแต่ยังทำงานไม่ได้ ผมก็คงช่วยได้เท่านี้ครับ เพราะในเครื่องผมทำงานได้เป็นปกติทุกประการ

ได้แล้วครับ เพราะผมกลับไปใช้

Private Sub AddData() แทน แล้วใช้คำสั่ง Call AddData เลยมีปัญหากับ Target แต่พอใส่ Code เข้าไปตรง Private Sub Worksheet_Change(ByVal Target As Range) ก็ไม่ Error แล้วครับ ขออภัยที่ทำให้อาจารย์เสียเวลากับผมไปด้วยครับ ขอบคุณอีกครั้งครับ

[Leng]

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    Dim rCheck As Range
    Dim ColAmount As Integer
    Dim ColName As Integer
    Dim lng As Long
    If Target.Count > 1 Then Exit Sub
    If Target.Column = 1 Then
        With Sheets("Sheet2")
            Set rCheck = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
        End With
        With Sheets("Sheet1")
            Set Rng = .Range("A1", .Range("C" & Rows.Count).End(xlUp))
        End With
        ColName = 2
        ColAmount = 3
        lng = Application.CountIf(Rng.Resize(, 1), Target)
        If lng >= 1 Then
            If Application.CountIf(rCheck, Target) > 1 Then
                MsgBox ("Double!!!")
            End If
            Target.Offset(0, 2) = Application.VLookup(Target, Rng, ColAmount, 0)
            Target.Offset(0, 1) = Application.VLookup(Target, Rng, ColName, 0)
        Else
             Target.Font.Color = vbRed
             Target.Font.Bold = True
        End If
    End If
End Sub

อยากให้อธิบายโค๊ดให้หน่อยครับว่าส่วนไหนทำอะไรจะนำไปปรับปรุงและใช้ครับ

[snasui]

ควรจะนำ Code ไปทดลองตามโจทย์แล้วลอง Run ทีละ Step ด้วยการกดแป้น F8 หากไม่เข้าใจบรรทัดใด กรุณายกมาถามเป็นรายบรรทัดครับ