/ / ลบรายการที่ซ้ำกันใน Excel VBA

ลบรายการที่ซ้ำกันใน Excel VBA

ด้านล่างเราจะดูที่โปรแกรมมา Excel VBA ที่ ลบรายการที่ซ้ำกัน.

สถานการณ์:

ในคอลัมน์ A เรามีตัวเลข 10 ตัว เราต้องการนำข้อมูลซ้ำออกจากตัวเลขเหล่านี้และวางตัวเลขเฉพาะในคอลัมน์ B

ลบรายการที่ซ้ำกันใน Excel VBA

1. ขั้นแรกเราจะประกาศตัวแปรสี่ตัว toAdd ชนิด Boolean, uniqueNumbers ประเภท Integer, i ของ Type Integer และ j ของ Type Integer

Dim toAdd As Boolean, uniqueNumbers As Integer, i As Integer, j As Integer

2. จากนั้นเราเขียนหมายเลขแรกของคอลัมน์ A ไปยังคอลัมน์ B เนื่องจากหมายเลขแรกอยู่ใน "unique" เสมอ

Cells(1, 2).Value = Cells(1, 1).Value

3. เราเริ่มต้นตัวแปรสองตัวแปร เราเพิ่งเพิ่มหมายเลขหนึ่งไปยังคอลัมน์ B ดังนั้นเราจึงเริ่มต้น uniqueNumbers ด้วยค่า 1 เราตั้งค่าเป็นAdd to True ถ้าสมมติว่าต้องมีการเพิ่มเลขต่อไปด้วยเช่นกัน (ซึ่งไม่จำเป็นต้องเป็นความจริงแน่นอน)

uniqueNumbers = 1
toAdd = True

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

4. เราต้องตรวจสอบหมายเลขสามเบอร์ที่สี่และอื่น ๆ เราเริ่มต้นสำหรับลูปถัดไปสำหรับสิ่งนี้

For i = 2 To 10

5 ตอนนี้เป็นส่วนที่สำคัญที่สุดของโปรแกรม ถ้าหมายเลขที่สองเท่ากับหนึ่งในตัวเลขในคอลัมน์ B (จนถึงตอนนี้เรามีเพียงหมายเลขเดียว) เราจะตั้งค่าเป็น "เท็จ" เพราะในกรณีนี้เราไม่ต้องการเพิ่มหมายเลขนี้ ") ในขณะที่ uniqueNumbers ยังคงเท่ากับ 1 แต่ uniqueNumbers อาจเป็นรายการทั้งหมดหากต้องการตรวจสอบรายการทั้งหมดนี้เราต้องใช้อีกวนสำหรับ Next อีกครั้ง: ถ้าจำนวนที่เราต้องการเพิ่มเท่ากับหนึ่งในจำนวน ในรายการนี้ toAdd จะถูกตั้งเป็น False และจะไม่เพิ่มหมายเลขเพิ่มบรรทัดต่อไปนี้:

For j = 1 To uniqueNumbers
    If Cells(i, 1).Value = Cells(j, 2).Value Then
        toAdd = False
    End If
Next j

6 เฉพาะถ้าเพิ่มยังคงเป็น True และไม่ได้ตั้งค่าเป็น False Excel VBA ต้องเพิ่มหมายเลขลงในคอลัมน์ B ในขณะเดียวกันเราจะเพิ่ม uniqueNumbers ขึ้นหนึ่งครั้งเนื่องจากเรามีหมายเลขที่ไม่เหมือนกันมากขึ้นในขณะนี้ สายรหัสต่อไปนี้ได้งานทำ:

If toAdd = True Then
    Cells(uniqueNumbers + 1, 2).Value = Cells(i, 1).Value
    uniqueNumbers = uniqueNumbers + 1
End If

7. สุดท้ายเราจะตั้งค่าเป็น Add to True ถ้าหากต้องการเพิ่มหมายเลขถัดไป (หมายเลขที่สาม) อีกครั้งนี้ไม่จำเป็นต้องเป็นจริง

toAdd = True

8. อย่าลืมปิดวง

Next i

วางแมโครของคุณในปุ่มคำสั่งและทดสอบ

ผล:

ลบผลลัพธ์ที่ซ้ำกัน

อ่านเพิ่มเติมได้ที่: