สอบถามโค๊ด VBA ในการดึงข้อมูลจากข้อมูลที่มีค่าซ้ำกัน

[knightking9]

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

ดึงข้อมูลที่ซ้ำกัน.xls

[snasui]

ได้เขียน VBA มาเองแล้วหรือไม่ครับ

หากยังให้เขียนมาเองก่อนตามกฎการใช้บอร์ดข้อ 5 ด้านบนครับ

[knightking9]

แก้ไขเป็นไฟล์ใหม่พร้อม VBA ครับ นี่คือโค๊ดทั้งหมดครับอาจารย์

Code: Select all

Sub MotherLotSelected()
Dim lngLastRow As Long
 
    Worksheets("Sampled").Select
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    
    If DoesWorkSheetExist("Mother_Lot_Sampled") = False Then  'If "Temp" sheet not there, create it.
        Worksheets.Add().Name = "Mother_Lot_Sampled"
    End If
    Worksheets("Mother_Lot_Sampled").Select
    ActiveSheet.Tab.ColorIndex = xlColorIndexNone               ' Remove tab color
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "MOTHERLOT"
    
    Range("B2").Select
    ActiveCell.Formula = "=LEFT(A2,13)"
    
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    'Range("B2").AutoFill Destination:=Range("B2:B" & lngLastRow)
    
    ActiveSheet.Move After:=ActiveWorkbook.Sheets("Load")

End Sub


Sub GroupAssignment()
Dim lngLastRow As Long
Dim lngLastRowSource As Long
Dim strLastRowSource As String
Dim strFormulaText As String


    Worksheets("Load").Select
    Range("H1").Select
    ActiveCell.Formula = "MOTHERLOT"
    
    Range("H2").Select
    ActiveCell.Formula = "=LEFT(B2,13)"
    
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Range("H2").AutoFill Destination:=Range("H2:H" & lngLastRow)
    
    Worksheets("Mother_Lot_Sampled").Select
    
    lngLastRowSource = Sheets("Mother_Lot_Sampled").Cells(Rows.Count, "A").End(xlUp).Row
    
    Worksheets("Load").Select
    
    Range("H1:H" & lngLastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("Mother_Lot_Sampled").Range("B1:B" & lngLastRowSource), Unique:=False
        
    Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData

   
         
    Range("C1").Select
    ActiveCell.Formula = "AA"
    
    Range("D1").Select
    ActiveCell.Formula = "BB"
    
    Range("E1").Select
    ActiveCell.Formula = "CC"
    
    Range("F1").Select
    ActiveCell.Formula = "DD"
    
    Range("G1").Select
    ActiveCell.Formula = "EE"
    
      
    
     Sheets("Data").Select
    lngLastRowSource = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row                   ' Get the last Target
    strLastRowSource = "$B$2:$N$" & CStr(lngLastRowSource)
    
    Worksheets("Load").Select
    
    Range("C2").Select
    ActiveCell.Formula = _
    "=IF(ISNA(VLOOKUP(A2,'Data'!" + strLastRowSource + ",2,FALSE)),""N/A"",VLOOKUP(A2,'Data'!" + strLastRowSource + ",2,FALSE))"

    Range("D2").Select
    ActiveCell.Formula = _
    "=IF(ISNA(VLOOKUP(A2,'Data'!" + strLastRowSource + ",3,FALSE)),""N/A"",VLOOKUP(A2,'Data'!" + strLastRowSource + ",3,FALSE))"
        
    Range("E2").Select
    ActiveCell.Formula = _
    "=IF(ISNA(VLOOKUP(A2,'Data'!" + strLastRowSource + ",4,FALSE)),""N/A"",VLOOKUP(A2,'Data'!" + strLastRowSource + ",4,FALSE))"
    
    Range("F2").Select
    ActiveCell.Formula = _
    "=IF(ISNA(VLOOKUP(A2,'Data'!" + strLastRowSource + ",5,FALSE)),""N/A"",VLOOKUP(A2,'Data'!" + strLastRowSource + ",5,FALSE))"

    Range("G2").Select
    ActiveCell.Formula = _
    "=IF(ISNA(VLOOKUP(A2,'Data'!" + strLastRowSource + ",6,FALSE)),""N/A"",VLOOKUP(A2,'Data'!" + strLastRowSource + ",6,FALSE))"

Range("C2:G2").Select
    lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Selection.AutoFill Destination:=Range("C2:G" & lngLastRow)
End Sub




Public Function DoesWorkSheetExist(WorkSheetName As String, Optional WorkBookName As String)
Dim WS As Worksheet
     
    On Error Resume Next
    If WorkBookName = vbNullString Then
        Set WS = Sheets(WorkSheetName)
    Else
        Set WS = Workbooks(WorkBookName).Sheets(WorkSheetName)
    End If
    On Error GoTo 0
     
    DoesWorkSheetExist = Not WS Is Nothing

End Function



Sub Main()
Const strHandledSheet As String = "Load"

On Error GoTo ErrorHandling
Worksheets(strHandledSheet).Select

    Application.ScreenUpdating = False
    
    
    MotherLotSelected
    GroupAssignment

Exit Sub

ErrorHandling:
    MsgBox ("No >> ") & strHandledSheet & ("<< sheet available")
    
End Sub

[knightking9]

ตอนนี้กำลังมีปัญหาว่า ต้องการจะดึงค่า โดยค่าที่ซ้ำกันคือ ID จากหน้า Data ครับ โดย 1 ID จะมี 2 Package ผมต้องการดึงทั้งสองอันมาแสดง ดังตัวอย่างในไฟล์ครับ รบกวนอาจารย์ขอคำแนะนำด้วยครับ ขอบคุณครับ

[knightking9]

กับรบกวนช่วยอธิบายโค๊ดส่วนนี้หน่อยครับ พอดีผมไม่ค่อยเข้าใจ

Code: Select all

Range("C2").Select
    ActiveCell.Formula = _
    "=IF(ISNA(VLOOKUP(A2,'Data'!" + strLastRowSource + ",[color=#FF0000]2[/color],FALSE)),""N/A"",VLOOKUP(A2,'Data'!" + strLastRowSource + ",[color=#FF0000]2[/color],FALSE))"

โดยเฉพาะส่วนเลข2 สีแดงหน้า FALSE คือค่าที่ดึงจากคอลัมป์ ในหน้า Data ใช่ไหมครับ แต่คอลัมป์ที่ต้องการในเซลล์ C2 ของหน้า Load ที่ถูกน่าจะต้องดึงจากคอลัมป์ที่ 3 ของหน้า Data ไม่ใช่ 2 แต่ทำไมกลับเป็น 2 ที่ถูกต้องครับ ขอบคุณครับ

[snasui]

เลขที่กล่าวถึงคือคอลัมน์ในสูตร ไม่ใช่คอลัมน์ของชีต

จากสูตรที่เขียนใน Code คือ VLOOKUP(A2,Data!$B$2:$N$4,2,FALSE) ข้อมูลที่จะนำมาแสดงคือ คือคอลัมน์ที่ 2 ของช่วงข้อมูล B2:N4 ซึ่งคอลัมน์ที่ 1 คือ B, 2 คือ C จึงนำคอลัมน์ C มาแสดง เช่นนี้ครับ

สำหรับการ Lookup ข้อมูลที่ค่าเหมือนกันแต่มีหลายบรรทัดด้วย Vlookup จะไม่สามารถทำได้ ค่าที่ได้มาจะเป็นค่าแรกหรือค่าสุดท้ายของขอมูลที่เหมือนกันนั้นแล้วแต่กำหนดค่าสุดท้ายของ Vlookup เป็นแบบใด ถ้าเป็น False จะนำค่าแรกมาแสดง ถ้าเป็น True จะนำค่าสุดท้ายมาแสดงในกรณีหลังนี้อยู่บนเงื่อนไขที่ว่าคอลัมน์ B จะต้องเรียงจากน้อยไปหามาก

หากจะใช้ Vlookup จะต้องสร้างความแตกต่างให้กับข้อมูลแต่ละบรรทัด ยกตัวอย่างเช่น กรณี Lookup ด้วย ID หาก ID เหมือนกันจะต้องสร้าง ID ใหม่เพื่อการ Lookup เช่น ID+Lot เช่นนี้เป็นต้น

หรือใช้การ Loop ด้วย Code แทนการ Lookup ด้วยสูตร ดูตัวอย่างด้านล่างซึ่งจะสร้างชีตใหม่มาให้ ลองปรับใช้ดูครับ

Code: Select all

Sub Test0()
    Dim rs As Range, rtAll As Range, rt As Range
    Dim s As Worksheet
    
    Set s = Worksheets.Add
    
    With Sheets("Data")
       Set rtAll = .Range("b2", .Range("b" & .Rows.Count).End(xlUp))
       .Range("a1:g1").Copy s.Range("a1")
    End With
    With Sheets("Load")
        For Each rs In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
            For Each rt In rtAll
                If rt.Value = rs.Value Then
                    s.Range("a" & .Rows.Count).End(xlUp).Offset(1, 0) _
                        .Resize(1, 7).Value = rt.Resize(1, 7).Value
                End If
            Next rt
        Next rs
    End With
End Sub

[knightking9]

ขอบคุณอาจารย์มากครับ ตัวอย่างที่อาจารย์ให้มา สามารถใช้เป็นแนวคิดต่อยอดต่อไปได้ครับ