หาค่าที่ไม่ซ้ำให้แสดงออกมา

[Methini]

สวัสดี ท่านผู้รู้ ทุกท่านคะ

ดิฉันไม่มีความรู้เรื่องการเขียนโค้ด VBA สักเท่าไหร่คะ
ดิฉันต้องการให้คีย์คำค้นที่ชีท "search" แถว A2 และ B2 เพื่อค้นหาข้อมูลในชีท "M_BOM" และดึงผลลัพธ์มาแสดงในชีท "result"
เช่น
Parent LOT
OEO10T101 0140

ให้แสดงรายการ child ออกมาทั้งหมดที่เป็นของ 0E010T01 LOT 0140 น้อยกว่าหรือเท่ากับ 0140

จึงติดปัญหาตรงโค้ดในส่วนนี้คะ
แต่ละตัวในแถว child ที่ได้นั้น ห้ามซ้ำกับคอลัมน์ Parent ในชีท "M_BOM" คะ

จึงรบกวนท่านผู้รู้ทุกท่านด้วยนะคะ

Code: Select all

 
Dim rBom As Range, rBomAll As Range
For Each rBom In rBomAll
       With Sheets("search")
       Sheets("result").Range("A1").Value = "PARENT"
        Sheets("result").Range("B1").Value = "CHILD"
          If rBom = .Range("A2") And rBom.Offset(0, 6).Value <= .Range("B2").Value And rBom.Offset(0, 7).Value >= .Range("B2").Value Then
             [color=#BF80FF]If rBom.Offset(0, 2).Value <> rBom.Offset(0, 0).Value Then[/color]
             Sheets("result").Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = rBom.Offset(0, 2)
             End If
             End If
      End With
      Next rBom

[snasui]

Code ควรปรับใหม่เป็นตามด้านล่าง การที่จะละ Collection เอาไว้ได้จะต้องมั่นใจว่า Object นั้นเป็นของ Collection นั้น

ยกตัวอย่างเช่น การจะเขียนว่า .range("a1") ซึ่งเป็นการละ Collection เอาไว้ เราจะต้องรู้ว่าก่อนหน้านั้นเราเขียน With ไว้เป็นอย่างไร ถ้าเขียนเป็น With Sheets("Sheet1") แสดงว่า .range("a1") เป็นของ Sheet1

ตัวอย่าง Code

Code: Select all

Private Sub CommandButton1_Click()
    Dim rBom As Range, rBomAll As Range, c As Range
    
    Set rBom = ActiveSheet.UsedRange
    If rBom.Count = 1 Then
        rBom = UCase(rBom)
    Else
        For Each c In rBom.SpecialCells(xlCellTypeConstants, xlTextValues)
            c.Value = UCase(c.Value)
        Next
    End If
    
    With Sheets("M_BOM")
        Set rBomAll = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
        Sheets("result").Range("A2") = Sheets("search").Range("A2")
        Sheets("result").Range("A1").Value = "PARENT"
        Sheets("result").Range("B1").Value = "CHILD"
        For Each rBom In rBomAll
            With Sheets("search")
                If rBom = Sheets("search").Range("A2") And rBom.Offset(0, 6).Value <= Sheets("search").Range("B2").Value _
                    And rBom.Offset(0, 7).Value >= Sheets("search").Range("B2").Value Then
                    If rBom.Offset(0, 2).Value <> rBom.Offset(0, 0).Value Then
                        Sheets("result").Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = rBom.Offset(0, 2)
                    End If
                End If
            End With
        Next rBom
        Worksheets("result").Activate
    End With
End Sub

ควรยกตัวอย่างข้อมูลมาในจำนวนที่ไม่มากนัก จะได้ง่ายต่อการตรวจสอบครับ

[Methini]

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

Code: Select all

Dim rBom As Range, rBomAll As Range, c As Range, r As Range, rChild As Range
    With Sheets("M_BOM")
        Set rBomAll = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
        Set rChild = .Range("B2", .Range("B" & .Rows.Count).End(xlUp))
        Sheets("result").Range("A2") = Sheets("search").Range("A2")
        Sheets("result").Range("A1").Value = "PARENT"
        Sheets("result").Range("B1").Value = "CHILD"

        For Each rBom In rBomAll
            With Sheets("search")
                    If rBom = Sheets("search").Range("A2") And rBom.Offset(0, 6).Value <= Sheets("search").Range("B2").Value _
                    And rBom.Offset(0, 7).Value >= Sheets("search").Range("B2").Value And rBom.Offset(0, 0).Value <> rBom.Offset(0, 2).Value Then
                     Sheets("result").Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = rBom.Offset(0, 2)
                   End If
            End With
       
            Next rBom
        Worksheets("result").Activate
    End With

รบกวนท่านผู้รู้ทุกท่านด้วยคะ

[Methini]

ลืมแนบไฟล์คะ

[snasui]

ตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

'Other code
For Each rBom In rBomAll
    With Sheets("search")
            If rBom = Sheets("search").Range("A2") And rBom.Offset(0, 6).Value <= Sheets("search").Range("B2").Value _
            And rBom.Offset(0, 7).Value >= Sheets("search").Range("B2").Value And rBom.Value <> rBom.Offset(0, 2).Value _
            And Application.CountIf(rBomAll, rBom.Offset(0, 2)) = 0 Then
                Sheets("result").Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = rBom.Offset(0, 2)
           End If
    End With
Next rBom

'Other code

[Methini]

ขอบคุณมากๆคะ สำหรับโค้ดที่ท่านแนะนำ ใช้งานได้เป็นอย่างดีเลย

[Methini]

สวัสดีคะ ท่านผู้รุ้ทุกท่าน
ดิฉันมีคำถามที่อยากจะขอคำแนะนำจากท่านคะ ถ้าดิฉันเปลี่ยนจากคำสั่ง For Each....Next เป็น Do While....Loop ดิฉันสามารถทำได้ไหมคะ ขอคำแนะนำเพื่อเป็นแนวทางในการเขียนโค้ดด้วยนะคะ
ขอบคุณคะ

[snasui]

การ Loop Object ด้วย For each...Next จะเร็วกว่า Do While...Loop สำหรับการเปลียนเป็น Do While...Loop ก็สามารถทำได้ แต่จะต้องเขียนมาเอง ติดตรงไหนแล้วค่อยถามกันครับ

[Methini]

สวัสดีค่ะ ท่านผู้รู้ทุกท่าน

ดิฉันได้ทำการฝึกเขียนโค้ดด้วยคำสั่ง Do while....Loop ค่ะ เหมือนมานั่งเริ่มต้นใหม่เลย ติดตรงปัญหาเดิมๆ อีกแล้วค่ะ

คือ ไม่สามารถนำผลลัพธ์ที่ได้มาแสดงโดยเรียงลงมาเป็นแถวได้ค่ะ คำตอบที่อยากได้ดิฉันเขียนไว้ในไฟล์ที่แนบมาคะ

Code: Select all

Dim intCount As Integer

 intCount = 2
   Do While Sheets("M_BOM").Cells(intCount, 1).Value <> ""
      If Sheets("search").Cells(intCount, 1).Value = Sheets("M_BOM").Cells(intCount, 1).Value Then
         Sheets("result").Cells(intCount, 1).Value = Sheets("search").Cells(intCount, 1).Value
         Sheets("result").Cells(intCount, 2).End(xlUp).Offset(1, 0) = Sheets("M_BOM").Cells(intCount, 3).Value
      
      End If
      intCount = intCount + 1
  Loop

รบกวนท่านผู้รู้ทุกท่านด้วยค่ะ

[snasui]

ตัวอย่างการปรับ Code ตามด้านล่างครับ

Code: Select all

intCount = 2
Do While Sheets("M_BOM").Cells(intCount, 1).Value <> ""
    If Sheets("search").Cells(2, 1).Value = Sheets("M_BOM").Cells(intCount, 1).Value Then
        If Sheets("result").Cells(2, 1) = "" Then
            Sheets("result").Cells(intCount, 1).Value = Sheets("search").Cells(2, 1).Value
        End If
    Sheets("result").Cells(intCount, 2).End(xlUp).Offset(1, 0) = Sheets("M_BOM").Cells(intCount, 3).Value
    End If
    intCount = intCount + 1
Loop

[Methini]

สวัสดีคะ ท่านผู้รู้ทุกท่าน

ขอบคุณท่านผู้รู้สำหรับคำแนะนำในการปรับโค้ดนะคะ

ต่อไปดิฉันจะนำคำตอบที่ได้ในชีท result คอลัมน์ A2 มาค้นหาในชีท M_BOM อีกทีหนึ่งคะ ซึ่งดิฉันติดปัญหาตรงที่ ดิฉันไม่สามารถวนลูปข้อมูลที่ได้ทุกแถวในชีท result ตั้งแต่คอลัมน์ A2 เป็นต้นไปคะ

โค้ดที่ติดปัญหาคะ

Code: Select all

  Do While Sheets("M_BOM").Cells(ma3, "A") <> ""
                 parentR = Sheets("result").Range("A3").Value
                 If Sheets("M_BOM").Cells(ma3, "A") = parentR Then
                    parent2 = Sheets("M_BOM").Cells(ma3, "A")
                    child2 = Sheets("M_BOM").Cells(ma3, "C")
                    slotP = Sheets("M_BOM").Cells(ma3, "G")
                    elotP = Sheets("M_BOM").Cells(ma3, "H")
          
 
   If lot >= slotP And lot <= elotP Then
      ma2 = 2
      Find2 = 0
      
      Do While Sheets("result").Cells(ma2, "A") <> ""
           If Sheets("result").Cells(ma2, "A") = child2 Then
           Find2 = 1
           Exit Do
           End If
           ma2 = ma2 + 1
           Loop
   
           If Find2 = 1 Then
             Sheets("result").Cells(ra2, "A") = child2
            ra2 = ra2 + 1
         Else
            Sheets("result").Cells(rb, "B") = child2
            Sheets("result").Cells(rb, "C") = "(" & parent2 & ")"
            Sheets("result").Cells(rb, "D") = slotP
            Sheets("result").Cells(rb, "E") = elotP
            rb = rb + 1
             End If
             End If
         End If
ma3 = ma3 + 1
Loop

ส่วนคำตอบที่อยากได้อยู่ในชีทที่แนบมาคะ

รบกวนท่านผู้รู้ทุกท่านด้วยนะคะ

[snasui]

ผมทำเป็นตัวอย่าง Code การปรับให้ Loop ในชีท Search ตั้งแต่ A2 เป็นต้นไป ซึ่งเป็นส่วนที่แจ้งมาว่าไม่สามารถเขียนให้ Loop ได้

ส่วนหากคำตอบไม่ได้ตามต้องการคุณต้องไปตรวจสอบดูว่า Code ที่เขียนมานั้นถูกต้องแล้วหรือไม่ อย่างไร แล้วค่อยนำถามกันต่อ

Code: Select all

Option Explicit

Sub Button2_Click()
    Dim Find, item, parent2, child2, ra, ra2, rb, y, lot, slotP, i ' declare i
    Dim elotP, r, re, re1, re2, ma1, ma2, parentR As Range 'declare parentR as range
    item = Sheets("search").Range("A2").Value
    lot = Sheets("search").Range("B2").Value
    r = 2
    re = 1
    re1 = 2
    re2 = 1
    ma1 = 2
    i = 0 ' assign value to i
    Set parentR = Sheets("result").Range("A2") 'set object to parentR
    Do While parentR.Offset(i, 0).Value <> ""
        Do While Sheets("M_BOM").Cells(ma1, "A") <> ""
            If Sheets("M_BOM").Cells(ma1, "A") = parentR Then
                parent2 = Sheets("M_BOM").Cells(ma1, "A")
                child2 = Sheets("M_BOM").Cells(ma1, "C")
                slotP = Sheets("M_BOM").Cells(ma1, "G")
                elotP = Sheets("M_BOM").Cells(ma1, "H")
                If lot >= slotP And lot <= elotP Then
                    ma2 = 1
                    Find = 0
                    Do While Sheets("result").Cells(ma2, "A") <> ""
                        If Sheets("result").Cells(ma2, "A") = child2 Then
                            Find = 1
                            Exit Do
                        End If
                        ma2 = ma2 + 1
                    Loop
                    If Find = 1 Then
                        Sheets("result").Cells(re2, "F") = child2
                        re2 = re2 + 1
                    Else
                        Sheets("result").Cells(re, "G") = "(" & parent2 & ") "
                        Sheets("result").Cells(re, "H") = child2
                        Sheets("result").Cells(re, "I") = slotP
                        Sheets("result").Cells(re, "J") = elotP
                        re = re + 1
                    End If
                End If
            End If
            ma1 = ma1 + 1
        Loop
        i = i + 1
    Loop
End Sub

[Methini]

สวัสดีคะ ท่านผู้รู้ทุกท่าน

ดิฉันได้นำโค้ดไปปรับและทดสอบโค้ดแล้ว ก็ไม่สามารถวนลูปได้คะ ดิฉันพยายามปรับเปลี่ยนหลายรอบแล้วคะ เมื่อปรับเปลี่ยนแล้วก็ยังไม่ได้ผลตามที่ต้องการ กรุณาให้คำแนะนำด้วยคะ เพราะค่อนข้างงงกับโค้ดคะ

โค้ดในส่วนนี้ พอรันแล้วไม่เห็นวนลูปให้เลยคะ

Code: Select all

 i = 0 ' assign value to i
    Set parentR = Sheets("result").Range("A2") 'set object to parentR
    Do While parentR.Offset(i, 0).Value <> ""
        i = i + 1
    Loop
  

[snasui]

ลองเปิดไฟล์ใหม่มา 1 ไฟล์แล้วทำตามนี้

1. เปลี่ยนชื่อ Sheet1 เป็น Result
2. ในชีท Result เซลล์ A2:A7 คีย์ค่าใด ๆ ตามต้องการ
3. เข้า VBE เข้าเมนู Insert เลือก Module
4. Copy Code ด้านล่างไปวางใน Module ที่เพิ่มเข้ามา

   Code: Select all

   Sub test()
       i = 0 ' assign value to i
       Set parentr = Sheets("result").Range("A2") 'set object to parentR
       Do While parentr.Offset(i, 0).Value <> ""
           MsgBox parentr.Offset(i, 0).Address
           i = i + 1
       Loop
   End Sub
   

5. กดแป้น F5 > สังเกตว่า Loop หรือไม่

[Methini]

สวัสดีคะ ท่านผู้รู้คะ

ดิฉันได้ทำตามทึ่ท่านบอกแล้วคะ ทดสอบแล้วสามารถวนลูปได้ แต่ทำไมเวลาเอาใส่ในโค้ดที่จะใช้จึงไม่สามารถวนลูปให้ดิฉันได้คะ
ผลที่ได้คือ A2 อย่างเดียวคะ ส่วน A3 ไม่เห็นแสดงออกมาคะ

รบกวนให้คำแนะนำอีกครั้งด้วยคะ ไม่มีความรู้ในเรื่องโค้ดเลยจริงๆคะ พยายามที่จะเรียนรู้ เพื่อการทำงานในหน้าที่ของตนเองอยู่คะ

ขอบคุณท่านผู้รู้ที่ให้คำแนะนำคะ

[snasui]

ผมทำเป็นตัวอย่าง Code การปรับให้ Loop ในชีท Search ตั้งแต่ A2 เป็นต้นไป ซึ่งเป็นส่วนที่แจ้งมาว่าไม่สามารถเขียนให้ Loop ได้

ส่วนหากคำตอบไม่ได้ตามต้องการคุณต้องไปตรวจสอบดูว่า Code ที่เขียนมานั้นถูกต้องแล้วหรือไม่ อย่างไร แล้วค่อยนำถามกันต่อ

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

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