VBA หาจำนวนซ้ำกันโดยไม่สนใจเครื่องหมาย บวก ลบ

[akekorn]

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

เอก

[snasui]

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

Code: Select all

Sub CK_DUP()
    Dim Cell As Range
    Dim Source As Range
    Dim Source1 As Range
    With Sheets("Sheet1")
        Set Source = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
        For Each Cell In Source
            Cell.Offset(0, 1).Value = Abs(Cell.Value)
        Next Cell
        Set Source1 = Source.Offset(0, 1)
        For Each Cell In .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
            If Application.WorksheetFunction.CountIf(Source1, Cell) > 1 Then
                Cell.Interior.Color = RGB(255, 0, 0)
            End If
        Next Cell
        Source1.ClearContents
     End With
    ' MsgBox (k)
End Sub

[akekorn]

ได้แล้วครับขอบคุณมากครับคุณคนควน

[akekorn]

แต่รบกวนอีกคำถามครับหากในการผมต้องการให้ใส่สีทั้งแถวตามตัวอย่างจะต้องปรับ code เป็นแบบไหนครับ
คืออ้างตั้งแต่ cell a:e ต้องเขียน vba แบบไหนครับ
ขอบคุณครับ

[logic]

ลองแบบนี้ครับ

Code: Select all

Sub CK_DUP()
    Dim Cell As Range
    Dim Source As Range
    Dim Source1 As Range
    With Sheets("Sheet1")
        Set Source = .Range("e2", .Range("e" & .Rows.Count).End(xlUp))
        For Each Cell In Source
            Cell.Offset(0, 1).Value = Abs(Cell.Value)
        Next Cell
        Set Source1 = Source.Offset(0, 1)
        For Each Cell In Source1
            If Application.WorksheetFunction.CountIf(Source1, Cell) > 1 Then
                Cell.Offset(0, -5).Resize(1, 5).Interior.Color = RGB(255, 0, 0)
            End If
        Next Cell
        Source1.ClearContents
    End With
    ' MsgBox (k)
End Sub

[akekorn]

ขอบคุณมากๆครับผม

[akekorn]

เรียน คุณคนควนและเพื่อนสมาชิกทุกท่าน
เนื่องจากมีการเปลี่ยน เงื่อนไข
- ว่าหากตัวเลขที่จะ highlight ต้องเป็นตัวเลขที่มีเครื่องหมาย + - ของคู่ตัวเอง โดยเริ่ม ตั้งแต่ 2 คู่ 4 คู่ 6 คู่ เหมือนกันแต่เป็น + -
- กรณีเป็น 0 ให้ถือว่าเป็นกลุ่มเดียวกันให้ highlight ทั้งกลุ่ม
- ถ้าเป็นตัวเลขเหมือนกัน และมีเพียงเครื่องหมาย + อย่างเดียว หรือ - อย่างเดียว จะไม่ highlight เพราะถือว่าไม่ใช่คู่
โดยผมลองปรับ code แต่ไม่สามารถได้ผลลัพภ์ ตามต้องการผมได้แนบ ตัวอย่างที่ทำมาด้วยครับ
ขอความอนุเคราะห์ ด้วยครับเพราะติดปัญหานี้แก้มาทั้งวันแต่ไม่ได้คำตอบที่ต้องการ
ขอบคุณมากๆครับผม

[snasui]

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

Code: Select all

Sub CK_DUP()
    Dim Cell As Range
    Dim Source As Range
    Dim v1 As Integer
    Dim v2 As Integer
    With Sheets("Sheet1")
    Set Source = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
    For Each Cell In Source
        v1 = Application.CountIf(Source, Cell.Value)
        v2 = Application.CountIf(Source, -Cell.Value)
        If Cell.Value = 0 Or (v1 > 0 And v2 > 0 And v1 - v2 = 0) Then
            Cell.Offset(0, 1).Interior.Color = RGB(0, 255, 0)
        End If
    Next Cell
    End With
End Sub

[akekorn]

ทำได้แล้วครับผม ขอบคุณ คุณ คนควนมากๆเลยครับ