:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

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

ฟอรัมถาม-ตอบปัญหาการใช้งานสูตรและฟังก์ชัน Excel
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
Post Reply
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#1

Post 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
You do not have the required permissions to view the files attached to this post.
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

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

#2

Post 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
:shock: :roll: :D
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#3

Post 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
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

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

#4

Post 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
:shock: :roll: :D
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#5

Post by monthikan »

ใช้ได้แล้วค่ะ ขอบคุณมากเลยนะคะ
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#6

Post 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
ตัวอย่างที่เเนบเป็นไฟล์ภาพค่ะ
You do not have the required permissions to view the files attached to this post.
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

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

#7

Post by puriwutpokin »

ลองแนบไฟล์ที่แก้ไขล่าสุด แล้วโค้ดที่ ใช้ครับ
:shock: :roll: :D
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#8

Post 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
You do not have the required permissions to view the files attached to this post.
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

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

#9

Post 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
:shock: :roll: :D
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#10

Post by monthikan »

ขอบคุณค่ะ :cp: :cp: :D :D :thup: :thup:
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#11

Post 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
You do not have the required permissions to view the files attached to this post.
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

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

#12

Post 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
:shock: :roll: :D
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#13

Post by monthikan »

:D :D ขอโทษค่ะ ดูไม่ดีเองค่ะ :D :D
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#14

Post 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
You do not have the required permissions to view the files attached to this post.
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

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

#15

Post 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
:shock: :roll: :D
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#16

Post 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
ขอบคุณค่ะ
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#17

Post 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
You do not have the required permissions to view the files attached to this post.
Top
User avatar
puriwutpokin
Guru
Guru
Posts: 3801
Joined: Fri Jan 04, 2013 9:49 pm
Location: Bangkok
Excel Ver: MS.365

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

#18

Post 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
:shock: :roll: :D
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#19

Post by monthikan »

:D :D ขอบคุณค่ะ
Top
monthikan
Member
Member
Posts: 26
Joined: Mon Mar 04, 2019 2:55 pm

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

#20

Post 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
You do not have the required permissions to view the files attached to this post.
Top
Post Reply

Return to “Excel Formulas & Functions”