Snasui Excel Forum

คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
https://www.snasui.com/

ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

https://www.snasui.com/viewtopic.php?t=14978

Page 1 of 2

ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Mon Mar 11, 2019 4:30 pm
by monthikan
ต้องการค้นหาข้อมูลที่ตรงกันค่ะ คือ เซลล์ J4 ตรงกับ ( C5:CXXXX) ตัวใดตัวหนึ่ง แล้วข้อมูลที่เป็น Batc , location, Palet No. และ Quantity ขึ้น ตอนนี้กด Run เเล้ว Bug ค่ะ

Code: Select all

Sub SearchBar()
 Dim i As Integer
 Dim j As Integer
 
 j = Sheets(1).Range("b" & Rows.Count).End(xlUp).Row

  i = Application.WorksheetFunction.Match(Sheets(1).Cells(4, 10), Sheets(2).Range("C5:C1728"), 0)
            Sheets(1).Cells(j + 1, 2).Value = Sheets(2).Cells(i, 3).Value 'tag
            Sheets(1).Cells(j + 1, 3).Value = Sheets(2).Cells(i, 4).Value 'Bach
            Sheets(1).Cells(j + 1, 4).Value = Sheets(2).Cells(i, 2).Value 'Lo
            Sheets(1).Cells(j + 1, 5).Value = Sheets(2).Cells(i, 5).Value 'Pallet
            Sheets(1).Cells(j + 1, 6).Value = Sheets(2).Cells(i, 6).Value 'Qty
           
            
End Sub

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Mon Mar 11, 2019 4:48 pm
by puriwutpokin
monthikan wrote: Mon Mar 11, 2019 4:30 pm ต้องการค้นหาข้อมูลที่ตรงกันค่ะ คือ เซลล์ J4 ตรงกับ ( C5:CXXXX) ตัวใดตัวหนึ่ง แล้วข้อมูลที่เป็น Batc , location, Palet No. และ Quantity ขึ้น ตอนนี้กด Run เเล้ว Bug ค่ะ

Code: Select all

Sub SearchBar()
 Dim i As Integer
 Dim j As Integer
 
 j = Sheets(1).Range("b" & Rows.Count).End(xlUp).Row

  i = Application.WorksheetFunction.Match(Sheets(1).Cells(4, 10), Sheets(2).Range("C5:C1728"), 0)
            Sheets(1).Cells(j + 1, 2).Value = Sheets(2).Cells(i, 3).Value 'tag
            Sheets(1).Cells(j + 1, 3).Value = Sheets(2).Cells(i, 4).Value 'Bach
            Sheets(1).Cells(j + 1, 4).Value = Sheets(2).Cells(i, 2).Value 'Lo
            Sheets(1).Cells(j + 1, 5).Value = Sheets(2).Cells(i, 5).Value 'Pallet
            Sheets(1).Cells(j + 1, 6).Value = Sheets(2).Cells(i, 6).Value 'Qty
           
            
End Sub
ปรับตามนี้ดูครับ :D

Code: Select all

Sub SearchBar()
 Dim i As Integer
 Dim j As Integer
 
 j = Sheets(2).Range("b" & Rows.Count).End(xlUp).Row + 1

  i = Application.WorksheetFunction.Match(Sheets(2).Cells(4, 10), Sheets(1).Range("C5:C1728"), 0) + 4
            Sheets(2).Cells(j, 2).Value = Sheets(1).Cells(i, 3).Value  'tag
            Sheets(2).Cells(j, 3).Value = Sheets(1).Cells(i, 4).Value  'Bach
            Sheets(2).Cells(j, 4).Value = Sheets(1).Cells(i, 2).Value  'Lo
            Sheets(2).Cells(j, 5).Value = Sheets(1).Cells(i, 5).Value  'Pallet
            Sheets(2).Cells(j, 6).Value = Sheets(1).Cells(i, 6).Value  'Qty
           
            
End Sub

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Mon Mar 11, 2019 5:10 pm
by monthikan
แก้ไขตามที่แนะนำแล้วค่ะ สามารถRunได้เรียบร้อย แต่ติด1ปัญหาค่ะ คือ เมื่อ Cell ที่เราป้อนข้อมูลสำหรับค้นหาเป็น Cell ว่าง (clear ออกเพื่อป้อนค่าใหม่) ทำให้มันBugค่ะ ไม่ทราบว่ามีวิธีแก้ไขไหมคะ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "J4" Then
     Call Searchbar.Searchbar
     End If
   
If Target.Address(4, 10) = " " Then
     Range("B6:F4000").ClearContents
     End If
End Sub

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Mon Mar 11, 2019 5:25 pm
by puriwutpokin
monthikan wrote: Mon Mar 11, 2019 5:10 pm แก้ไขตามที่แนะนำแล้วค่ะ สามารถRunได้เรียบร้อย แต่ติด1ปัญหาค่ะ คือ เมื่อ Cell ที่เราป้อนข้อมูลสำหรับค้นหาเป็น Cell ว่าง (clear ออกเพื่อป้อนค่าใหม่) ทำให้มันBugค่ะ ไม่ทราบว่ามีวิธีแก้ไขไหมคะ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "J4" Then
     Call Searchbar.Searchbar
     End If
   
If Target.Address(4, 10) = " " Then
     Range("B6:F4000").ClearContents
     End If
End Sub
ปรับเป็น

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "J4" Then
     Call SearchBar
     End If
If Target.Address(4, 10) = "" Then
     Range("B6:F4000").ClearContents
     End If
End Sub
และ

Code: Select all

Sub SearchBar()
 Dim i As Integer
 Dim j As Integer
 On Error Resume Next
 'Other code

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Mon Mar 11, 2019 5:40 pm
by monthikan
ใช้ได้แล้วค่ะ ขอบคุณมากเลยนะคะ

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Mon Mar 11, 2019 9:35 pm
by monthikan
puriwutpokin wrote: Mon Mar 11, 2019 5:25 pm
monthikan wrote: Mon Mar 11, 2019 5:10 pm แก้ไขตามที่แนะนำแล้วค่ะ สามารถRunได้เรียบร้อย แต่ติด1ปัญหาค่ะ คือ เมื่อ Cell ที่เราป้อนข้อมูลสำหรับค้นหาเป็น Cell ว่าง (clear ออกเพื่อป้อนค่าใหม่) ทำให้มันBugค่ะ ไม่ทราบว่ามีวิธีแก้ไขไหมคะ

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "J4" Then
     Call Searchbar.Searchbar
     End If
   
If Target.Address(4, 10) = " " Then
     Range("B6:F4000").ClearContents
     End If
End Sub
ปรับเป็น

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "J4" Then
     Call SearchBar
     End If
If Target.Address(4, 10) = "" Then
     Range("B6:F4000").ClearContents
     End If
End Sub
และ

Code: Select all

Sub SearchBar()
 Dim i As Integer
 Dim j As Integer
 On Error Resume Next
 'Other code
ได้มีการนำ Code มาปรับใช้กับการค้นหาตัวอื่นค่ะ สำหรับกรณีที่ข้อมูลที่ match กันมีมากกว่า1ค่า ทำอย่างไรให้สามารถแสดงค่าข้อมูลทั้งหมด ยกตัวอย่างการค้นหาเลข Batch ที่ A19C8DNN มีข้อมูลใน WH STATUS อยู่ 3 ค่า แต่พอ Run เเล้วขึ้นเเค่ 1 ค่า มีวิธีแก้ไขอย่างไรให้แสดงข้อมูลทั้งหมดมาในหน้า SEARCH ค่ะ

Code: Select all

Sub SearchBatchInWH()
 Dim i As Integer
 Dim j As Integer
 On Error Resume Next 'Other code
 j = Sheets(9).Range("b" & Rows.Count).End(xlUp).Row

  i = Application.WorksheetFunction.Match(Sheets(9).Cells(7, 10), Sheets(6).Range("D1:D1728"), 0)
            Sheets(9).Cells(j + 1, 2).Value = Sheets(6).Cells(i, 3).Value 'tag
            Sheets(9).Cells(j + 1, 3).Value = Sheets(6).Cells(i, 4).Value 'Bach
            Sheets(9).Cells(j + 1, 4).Value = Sheets(6).Cells(i, 2).Value 'Lo
            Sheets(9).Cells(j + 1, 5).Value = Sheets(6).Cells(i, 5).Value 'Pallet
            Sheets(9).Cells(j + 1, 6).Value = Sheets(6).Cells(i, 6).Value 'Qty
           
            
End Sub
ตัวอย่างที่เเนบเป็นไฟล์ภาพค่ะ

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Mon Mar 11, 2019 9:42 pm
by puriwutpokin
ลองแนบไฟล์ที่แก้ไขล่าสุด แล้วโค้ดที่ ใช้ครับ

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Mon Mar 11, 2019 10:21 pm
by monthikan
เป็นอันนี้ค่ะที่นำมาปรับใช้ เเก้ไขล่าสุด เป็นข้อมูลของ Batch ค่ะ

Code: Select all

Sub SearchBatch()
 Dim i As Integer
 Dim j As Integer
 On Error Resume Next
 'Other code
 j = Sheets(2).Range("b" & Rows.Count).End(xlUp).Row + 1

  i = Application.WorksheetFunction.Match(Sheets(2).Cells(6, 10), Sheets(1).Range("D5:C1728"), 0) + 4
            Sheets(2).Cells(j, 2).Value = Sheets(1).Cells(i, 3).Value  'tag
            Sheets(2).Cells(j, 3).Value = Sheets(1).Cells(i, 4).Value  'Bach
            Sheets(2).Cells(j, 4).Value = Sheets(1).Cells(i, 2).Value  'Lo
            Sheets(2).Cells(j, 5).Value = Sheets(1).Cells(i, 5).Value  'Pallet
            Sheets(2).Cells(j, 6).Value = Sheets(1).Cells(i, 6).Value  'Qty
           
            
End Sub

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Mon Mar 11, 2019 11:10 pm
by puriwutpokin
monthikan wrote: Mon Mar 11, 2019 10:21 pm เป็นอันนี้ค่ะที่นำมาปรับใช้ เเก้ไขล่าสุด เป็นข้อมูลของ Batch ค่ะ

Code: Select all

Sub SearchBatch()
 Dim i As Integer
 Dim j As Integer
 On Error Resume Next
 'Other code
 j = Sheets(2).Range("b" & Rows.Count).End(xlUp).Row + 1

  i = Application.WorksheetFunction.Match(Sheets(2).Cells(6, 10), Sheets(1).Range("D5:C1728"), 0) + 4
            Sheets(2).Cells(j, 2).Value = Sheets(1).Cells(i, 3).Value  'tag
            Sheets(2).Cells(j, 3).Value = Sheets(1).Cells(i, 4).Value  'Bach
            Sheets(2).Cells(j, 4).Value = Sheets(1).Cells(i, 2).Value  'Lo
            Sheets(2).Cells(j, 5).Value = Sheets(1).Cells(i, 5).Value  'Pallet
            Sheets(2).Cells(j, 6).Value = Sheets(1).Cells(i, 6).Value  'Qty
           
            
End Sub
ปรับเป็นตามนี้ดูครับ :D :D

Code: Select all

Sub SearchBatch()
 Dim j As Integer
Dim rng As Range
 On Error Resume Next
    Set rng = Sheets(1).Range("D5:D1728")
    For Each c In rng
    j = Sheets(2).Range("b" & Rows.Count).End(xlUp).Row + 1
    If c.Value = Sheets(2).Cells(6, 10) Then
    Sheets(2).Cells(j, 2).Value = c.Offset(, -1).Value
    Sheets(2).Cells(j, 3).Value = c.Offset(, 0).Value
    Sheets(2).Cells(j, 4).Value = c.Offset(, -2).Value
    Sheets(2).Cells(j, 5).Value = c.Offset(, 1).Value
    Sheets(2).Cells(j, 6).Value = c.Offset(, 2).Value
    End If
Next c
End Sub

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Mon Mar 11, 2019 11:54 pm
by monthikan
ขอบคุณค่ะ :cp: :cp: :D :D :thup: :thup:

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Tue Mar 12, 2019 10:19 am
by monthikan
ตอนนี้ลองปรับ Code เเล้วนะคะ แต่มันขึ้นแค่ 2 ตัวค่ะ

Code: Select all

Sub SearchBatch()
 Dim j As Integer
Dim rng As Range
 On Error Resume Next
    Set rng = Sheets(1).Range("D5:D1728")
    For Each c In rng
    j = Sheets(2).Range("b" & Rows.Count).End(xlUp).Row + 1
    If c.Value = Sheets(2).Cells(6, 10) Then
    Sheets(2).Cells(j, 2).Value = c.Offset(, -1).Value
    Sheets(2).Cells(j, 3).Value = c.Offset(, 0).Value
   Sheets(2).Cells(j, 4).Value = c.Offset(, -2).Value
    Sheets(2).Cells(j, 5).Value = c.Offset(, 1).Value
    Sheets(2).Cells(j, 6).Value = c.Offset(, 2).Value
    End If
Next c
End Sub

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Tue Mar 12, 2019 11:42 am
by puriwutpokin
monthikan wrote: Tue Mar 12, 2019 10:19 am ตอนนี้ลองปรับ Code เเล้วนะคะ แต่มันขึ้นแค่ 2 ตัวค่ะ

Code: Select all

Sub SearchBatch()
 Dim j As Integer
Dim rng As Range
 On Error Resume Next
    Set rng = Sheets(1).Range("D5:D1728")
    For Each c In rng
    j = Sheets(2).Range("b" & Rows.Count).End(xlUp).Row + 1
    If c.Value = Sheets(2).Cells(6, 10) Then
    Sheets(2).Cells(j, 2).Value = c.Offset(, -1).Value
    Sheets(2).Cells(j, 3).Value = c.Offset(, 0).Value
   Sheets(2).Cells(j, 4).Value = c.Offset(, -2).Value
    Sheets(2).Cells(j, 5).Value = c.Offset(, 1).Value
    Sheets(2).Cells(j, 6).Value = c.Offset(, 2).Value
    End If
Next c
End Sub
ถูกแล้วครับ ที่ ชีท1 มีแค่2 ตัวครับ ดูดีๆก่อนว่าใช่ไหมครับ :D :D

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Tue Mar 12, 2019 12:13 pm
by monthikan
:D :D ขอโทษค่ะ ดูไม่ดีเองค่ะ :D :D

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Wed Mar 13, 2019 2:34 pm
by monthikan
เอา Code มาเขียนใช้อีกอันหนึ่งแต่มันไม่ขึ้นค่ะ Run รอบบเเรกมันขึ้นที่เซลล์อื่นก็เลยลองแก้ พอ Run รอบสองไม่ขึ้นเลย
เป็นการผูกให้วันที่ ที่ Range("A:A") sheets(1) ตรงกับ Cells(3,9) sheets(4) เเล้วข้อมูลที่ต้องการจะขึ้นค่ะ

Code: Select all

Sub ReportStorage()
    Dim j As Integer
    Dim rng As Range
        On Error Resume Next
        Set rng = Sheets(1).Range("A:A")
            For Each c In rng
                j = Sheets(4).Range("C" & Rows.Count).End(xlUp).Row
                    If c.Value = Sheets(3).Cells(3, 9) Then
                        Sheets(3).Cells(j, 3).Value = c.office(, 2).Value 'tag
                        Sheets(3).Cells(j, 4).Value = c.office(, 3).Value 'mat
                        Sheets(3).Cells(j, 5).Value = c.office(, 5).Value 'bat
                        Sheets(3).Cells(j, 6).Value = c.office(, 4).Value 'pa
                        Sheets(3).Cells(j, 7).Value = c.office(, 1).Value 'lo
                        Sheets(3).Cells(j, 8).Value = c.office(, 7).Value 'qt
                        Sheets(3).Cells(j, 9).Value = c.office(, 9).Value 're
                    End If
            Next c
End Sub

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Wed Mar 13, 2019 2:58 pm
by puriwutpokin
monthikan wrote: Wed Mar 13, 2019 2:34 pm เอา Code มาเขียนใช้อีกอันหนึ่งแต่มันไม่ขึ้นค่ะ Run รอบบเเรกมันขึ้นที่เซลล์อื่นก็เลยลองแก้ พอ Run รอบสองไม่ขึ้นเลย
เป็นการผูกให้วันที่ ที่ Range("A:A") sheets(1) ตรงกับ Cells(3,9) sheets(4) เเล้วข้อมูลที่ต้องการจะขึ้นค่ะ

Code: Select all

Sub ReportStorage()
    Dim j As Integer
    Dim rng As Range
        On Error Resume Next
        Set rng = Sheets(1).Range("A:A")
            For Each c In rng
                j = Sheets(4).Range("C" & Rows.Count).End(xlUp).Row
                    If c.Value = Sheets(3).Cells(3, 9) Then
                        Sheets(3).Cells(j, 3).Value = c.office(, 2).Value 'tag
                        Sheets(3).Cells(j, 4).Value = c.office(, 3).Value 'mat
                        Sheets(3).Cells(j, 5).Value = c.office(, 5).Value 'bat
                        Sheets(3).Cells(j, 6).Value = c.office(, 4).Value 'pa
                        Sheets(3).Cells(j, 7).Value = c.office(, 1).Value 'lo
                        Sheets(3).Cells(j, 8).Value = c.office(, 7).Value 'qt
                        Sheets(3).Cells(j, 9).Value = c.office(, 9).Value 're
                    End If
            Next c
End Sub
ควรจะเป็น วันให้เป็น คศ ไม่ควรใช้พศ เพราะระบบจะเข้าใจผิดได้ครับ และควรจำกัด ช่วง A:A ด้วยครับ เพราะมันจะค้นหาไปจนบรรทัดสุดท้ายก่อนจบ :D

Code: Select all

Sub ReportStorage()
    Dim j As Integer
    Dim rng As Range
        On Error Resume Next
        Set rng = Sheets(1).Range("A:A")
            For Each c In rng
                j = Sheets(3).Range("C" & Rows.Count).End(xlUp).Row + 1
                    If c.Value = Sheets(3).Cells(3, 9) Then
                        Sheets(3).Cells(j, 3).Value = c.Offset(, 2).Value 'tag
                        Sheets(3).Cells(j, 4).Value = c.Offset(, 3).Value 'mat
                        Sheets(3).Cells(j, 5).Value = c.Offset(, 5).Value 'bat
                        Sheets(3).Cells(j, 6).Value = c.Offset(, 4).Value 'pa
                        Sheets(3).Cells(j, 7).Value = c.Offset(, 1).Value 'lo
                        Sheets(3).Cells(j, 8).Value = c.Offset(, 7).Value 'qt
                        Sheets(3).Cells(j, 9).Value = c.Offset(, 9).Value 're
                    End If
            Next c
End Sub

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Wed Mar 13, 2019 3:21 pm
by monthikan
puriwutpokin wrote: Wed Mar 13, 2019 2:58 pm
monthikan wrote: Wed Mar 13, 2019 2:34 pm เอา Code มาเขียนใช้อีกอันหนึ่งแต่มันไม่ขึ้นค่ะ Run รอบบเเรกมันขึ้นที่เซลล์อื่นก็เลยลองแก้ พอ Run รอบสองไม่ขึ้นเลย
เป็นการผูกให้วันที่ ที่ Range("A:A") sheets(1) ตรงกับ Cells(3,9) sheets(4) เเล้วข้อมูลที่ต้องการจะขึ้นค่ะ

Code: Select all

Sub ReportStorage()
    Dim j As Integer
    Dim rng As Range
        On Error Resume Next
        Set rng = Sheets(1).Range("A:A")
            For Each c In rng
                j = Sheets(4).Range("C" & Rows.Count).End(xlUp).Row
                    If c.Value = Sheets(3).Cells(3, 9) Then
                        Sheets(3).Cells(j, 3).Value = c.office(, 2).Value 'tag
                        Sheets(3).Cells(j, 4).Value = c.office(, 3).Value 'mat
                        Sheets(3).Cells(j, 5).Value = c.office(, 5).Value 'bat
                        Sheets(3).Cells(j, 6).Value = c.office(, 4).Value 'pa
                        Sheets(3).Cells(j, 7).Value = c.office(, 1).Value 'lo
                        Sheets(3).Cells(j, 8).Value = c.office(, 7).Value 'qt
                        Sheets(3).Cells(j, 9).Value = c.office(, 9).Value 're
                    End If
            Next c
End Sub
ควรจะเป็น วันให้เป็น คศ ไม่ควรใช้พศ เพราะระบบจะเข้าใจผิดได้ครับ และควรจำกัด ช่วง A:A ด้วยครับ เพราะมันจะค้นหาไปจนบรรทัดสุดท้ายก่อนจบ :D

Code: Select all

Sub ReportStorage()
    Dim j As Integer
    Dim rng As Range
        On Error Resume Next
        Set rng = Sheets(1).Range("A:A")
            For Each c In rng
                j = Sheets(3).Range("C" & Rows.Count).End(xlUp).Row + 1
                    If c.Value = Sheets(3).Cells(3, 9) Then
                        Sheets(3).Cells(j, 3).Value = c.Offset(, 2).Value 'tag
                        Sheets(3).Cells(j, 4).Value = c.Offset(, 3).Value 'mat
                        Sheets(3).Cells(j, 5).Value = c.Offset(, 5).Value 'bat
                        Sheets(3).Cells(j, 6).Value = c.Offset(, 4).Value 'pa
                        Sheets(3).Cells(j, 7).Value = c.Offset(, 1).Value 'lo
                        Sheets(3).Cells(j, 8).Value = c.Offset(, 7).Value 'qt
                        Sheets(3).Cells(j, 9).Value = c.Offset(, 9).Value 're
                    End If
            Next c
End Sub
ขอบคุณค่ะ

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Wed Mar 13, 2019 6:00 pm
by monthikan
ได้แก้ Code ตามที่เเนะนำเเล้วค่ะ Run ได้ค่ะ แต่พอทำอีกรอบมันไม่ขึ้น Cell ที่ต้องการค่ะแต่ไปขึ้นที่ Cell 41 แทน ลองใส่ j - 35 แล้ว แต่ค่า c กับไม่ทำซ้ำ

Code: Select all

Sub ReportRetriev()
    Dim j As Integer
    Dim rng As Range
    
        On Error Resume Next
        Set rng = Sheets(2).Range("A1:A1000")
            For Each c In rng
                j = Sheets(3).Range("c" & Rows.Count).End(xlUp).Row + 1
                    If c.Value = Sheets(3).Cells(3, 9) Then
                        Sheets(3).Cells(j, 3).Value = c.Offset(, 2).Value
                        Sheets(3).Cells(j, 4).Value = c.Offset(, 3).Value
                        Sheets(3).Cells(j, 5).Value = c.Offset(, 5).Value
                        Sheets(3).Cells(j, 6).Value = c.Offset(, 6).Value
                        Sheets(3).Cells(j, 7).Value = c.Offset(, 1).Value
                        Sheets(3).Cells(j, 8).Value = c.Offset(, 7).Value
                        Sheets(3).Cells(j, 9).Value = c.Offset(, 9).Value
                    End If
            Next c
End Sub

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Wed Mar 13, 2019 7:18 pm
by puriwutpokin
monthikan wrote: Wed Mar 13, 2019 6:00 pm ได้แก้ Code ตามที่เเนะนำเเล้วค่ะ Run ได้ค่ะ แต่พอทำอีกรอบมันไม่ขึ้น Cell ที่ต้องการค่ะแต่ไปขึ้นที่ Cell 41 แทน ลองใส่ j - 35 แล้ว แต่ค่า c กับไม่ทำซ้ำ

Code: Select all

Sub ReportRetriev()
    Dim j As Integer
    Dim rng As Range
    
        On Error Resume Next
        Set rng = Sheets(2).Range("A1:A1000")
            For Each c In rng
                j = Sheets(3).Range("c" & Rows.Count).End(xlUp).Row + 1
                    If c.Value = Sheets(3).Cells(3, 9) Then
                        Sheets(3).Cells(j, 3).Value = c.Offset(, 2).Value
                        Sheets(3).Cells(j, 4).Value = c.Offset(, 3).Value
                        Sheets(3).Cells(j, 5).Value = c.Offset(, 5).Value
                        Sheets(3).Cells(j, 6).Value = c.Offset(, 6).Value
                        Sheets(3).Cells(j, 7).Value = c.Offset(, 1).Value
                        Sheets(3).Cells(j, 8).Value = c.Offset(, 7).Value
                        Sheets(3).Cells(j, 9).Value = c.Offset(, 9).Value
                    End If
            Next c
End Sub
ปรับตามนี้ครับ ต้องสังเกต เมื่อมีการเปลี่ยนโค้ดไปใช้กับส่วนอื่นด้วยครับ ว่ามีความต่างกันตรงไหนสังเกตว่ามีอะไรที่เหมือน
ที่ไม่เหมือนแล้วแก้ไขดูได้ครับ แล้วอย่าเซฟเมื่อรันแล้วผิดครับ :D :D :D

Code: Select all

Sub ReportRetriev()
    Dim j As Integer
    Dim c, rng As Range
        On Error Resume Next
       Set rng = Sheets(2).Range("a6:a" & Sheets(2).Range("a" & Rows.Count).End(xlUp).Row)
            For Each c In rng
            With Sheets(3)
                j = .Range("e" & .Rows.Count).End(xlUp).Row + 1
                    If c.Value = .Cells(3, 9) Then
                        .Cells(j, 3).Value = c.Offset(, 2).Value
                        .Cells(j, 4).Value = c.Offset(, 3).Value
                        .Cells(j, 5).Value = c.Offset(, 5).Value
                        .Cells(j, 6).Value = c.Offset(, 6).Value
                        .Cells(j, 7).Value = c.Offset(, 1).Value
                        .Cells(j, 8).Value = c.Offset(, 7).Value
                        .Cells(j, 9).Value = c.Offset(, 9).Value
                    End If
                End With
            Next c
End Sub

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Wed Mar 13, 2019 10:00 pm
by monthikan
:D :D ขอบคุณค่ะ

Re: ต้องการค้าหาข้อมูลที่ตรงกันค่ะ

Posted: Thu Mar 14, 2019 5:18 pm
by monthikan
กรณีที่ข้อมูลมีเยอะแต่ต้องการให้ข้อมูลหยุดอยู่ที่บรรทัดที่ 35 ค่ะ แล้วให้ข้อมูลที่เหลือขึ้นบรรทัดใหม่ตามที่ต้องการ VBA สามารถเขียนได้ไหมคะ พยายามลองหาข้อมูลเพื่อเขียนเเล้วเเต่ทำไม่ได้จริงๆ ช่วยเเนะนำเเนวทางได้ไหมคะ :cry: :cry: :cry: :cry:

Code: Select all

Sub SReportRetriev()
    Dim j As Integer
    Dim l As Long
    Dim c, rng As Range
        On Error Resume Next
       Set rng = Sheets(2).Range("a6:a" & Sheets(2).Range("a" & Rows.Count).End(xlUp).Row)
            For Each c In rng
            With Sheets(3)
                j = .Range("e" & .Rows.Count).End(xlUp).Row + 1
                    If c.Value = .Cells(3, 9) Then
                        .Cells(j, 3).Value = c.Offset(, 2).Value
                        .Cells(j, 4).Value = c.Offset(, 3).Value
                        .Cells(j, 5).Value = c.Offset(, 5).Value
                        .Cells(j, 6).Value = c.Offset(, 6).Value
                        .Cells(j, 7).Value = c.Offset(, 1).Value
                        .Cells(j, 8).Value = c.Offset(, 7).Value
                        .Cells(j, 9).Value = c.Offset(, 9).Value
                    End If
                End With
            Next c
              
        With Sheets(3)

            l = .Range("C35" & .Rows.Count).End(xlUp).Row + 1
       
            .Range("C41" & l).Select
        End With

End Sub
All times are UTC+07:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited