นำข้อมูลจากหลายชีตมาเรียงใหม่เฉพาะค่าที่ไม่ซ้ำ

Excel มีเครื่องมือสำหรับการนำเฉพาะค่าที่ไม่ซ้ำมาแสดงคือ Data > Remove Duplicates แต่จะทำเช่นนี้ได้ข้อมูลจะต้องอยู่ในชีตเดียวกันเท่านั้น หากข้อมูลอยู่ในหลาย ๆ ชีต แต่ละชีตมีหลายตำแหน่ง จะไม่สามารถใช้เครื่องมือตัวนี้จัดการได้ในทันที จำเป็นต้องใช้ VBA เข้ามาจัดการ ?

Video ด้านล่างนี้เป็นการนำค่าจากหลายชีตและหลายคอลัมน์และมีตำแหน่งไม่แน่นอนมาจัดเรียงใหม่เป็น Database ด้วย VBA โดยข้อมูลที่ซ้ำกันจะนำมาแสดงเพียงค่าเดียว สามารถทำซ้ำได้ตามต้องการ หากเป็นการทำซ้ำโปรแกรมจะทำการลบข้อมูลที่มีอยู่เดิมใน Database ทิ้งไปก่อนแล้วค่อย Loop เพื่อนำค่ามาแสดงใหม่ ตัวอย่าง Code ตามด้านล่างครับ

Sub CollectDataFromMultipleSheets()
    Dim s As Worksheet, r As Range, d As Object
    Set d = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    For Each s In Worksheets
        For Each r In s.UsedRange.SpecialCells( _
            xlCellTypeConstants)
            If Not d.Exists(r.Value) Then
                d.Add r.Value, r.Value
            End If
        Next r
    Next s
    With Sheets("Sheet1").Application
        .Range("a:a").ClearContents
        .Range("a1").Resize(d.Count).Value = _
            .Transpose(d.keys)
    End With
End Sub

Video แสดงการนำข้อมูลหลายชีตมาเรียงใหม่เฉพาะค่าที่ไม่ซ้ำ