การดึงค่าข้าม Sheet

[sanorte9]

ก่อนผมจะถามผมได้พยายามลองทำดูนานมากแต่ไม่ได้ โดยใช้ Do While ไม่รู้ว่านำมาใช้ผิดประเภทหรือปล่าว

ผมมี Sheet อยู่ 2 Sheet
1. Program

pro.jpg

2. ProductDB

db.jpg

สิ่งที่ผมต้องการคือ ใส่ค่าลงในช่อง รหัส ที่ Program แล้วเมื่อกดปุ่ม ตรวจสอบ ให้ทำการเปรียบเทียบกับ ProductDB
- ถ้ารหัสที่ใส่ใน Program มีอยู่ใน ProductDB ให้เขียน รายการ และ ราคา จาก ProductDB ลงใน Program
- ถ้ารหัสที่ใส่ใน Program ไม่มีอยู่ใน ProductDB ให้แสดง MsgBox ว่า ไม่พบxxx ปล.xxx คือข้อความที่เขียนลงไปแล้วไม่พบ
- ไม่ต้องใสรหัสให้ครบทุกช่องใน Program (เปรียบเทียบเฉพาะช่องที่มีการป้อน)
- รหัสที่ใส่ใน Program ไม่ต้องเรียงตาม ProductDB เช่น ใส่ A001,A007,A005

นอกจากเงื่อนไขดังกล่าวแล้วผมอยากทราบอีก 2 กรณี คือ
1.กรณีป้อนรหัสลงใน Program โดยห้ามเว้นช่องลำดับ เช่น ป้อนรหัส ในลำดับ 1,2,3,4,5,6 และถ้ามีการเว้น ให้แสดง MsgBox ว่า ลำดับxxผิดพลาด ปล.xx คือลำดับที่มีการเว้นว่าและข้ามไปทำลำดับอื่น
2.กรณีป้อนรหัสลงใน Program โดยเว้นช่องลำดับได้ เช่น ป้อนรหัส ในลำดับ 1,4,5,7

ขอขอบคุณล่วงหน้าครับ ผมน้องใหม่จริงๆ รบกวนด้วยครับผม

[snasui]

กรณีเป็น VBA จำเป็นต้องเขียนมาก่อนครับ ที่บอกว่าไม่ได้นั้นได้เขียนไว้แล้วอย่างไร ส่งไฟล์และ Code นั้นมาด้วยครับจะได้ช่วยกันดูได้

[sanorte9]

ผมทำได้ประมาณนี้ ซึ่งยังมีอีกหลายประการที่ไม่เข้าท่า
ทำได้ตอนนี้คือ
-ตรวจสอบได้แต่ต้องใส่ตามลำดับตาม ProductDB

ไม่ทราบว่าจะทำอย่างไรให้ที่ Program รหัส 1 ช่อง วิ่งตรวจที่ ProductDB 1ครั้ง
ยังไงรบกวนด้วย

Code: Select all

Private Sub CommandButton1_Click()
Dim iRow As Integer
Dim jRow As Integer
iRow = 4
jRow = 5
Do While Worksheets("Program").Range("C" & jRow).Value <> ""
If Worksheets("ProductDB").Range("D" & iRow).Value = Worksheets("Program").Range("C" & jRow).Value Then
Worksheets("Program").Range("D" & jRow).Value = Worksheets("ProductDB").Range("E" & iRow).Value
Worksheets("Program").Range("E" & jRow).Value = Worksheets("ProductDB").Range("F" & iRow).Value
End If
iRow = iRow + 1
jRow = jRow + 1
Loop
End Sub

[snasui]

ช่วยส่งไฟล์ตัวอย่าง แนบ Code มาให้ด้วยครับ ผมและเพื่อน ๆ จะได้ไม่ต้องเสียเวลาทำตัวอย่างขึ้นมาเลียนแบบ

กรณีเป็น VBA จำเป็นต้องเขียนมาก่อนครับ ที่บอกว่าไม่ได้นั้นได้เขียนไว้แล้วอย่างไร ส่งไฟล์และ Code นั้นมาด้วยครับจะได้ช่วยกันดูได้

[sanorte9]

นี่ครับ

Book1.xlsm

[snasui]

ลองปรับ Code เป็นตามด้านล่างครับ

Code: Select all

Private Sub CommandButton1_Click()
'    Dim iRow As Integer
'    Dim jRow As Integer
'    iRow = 4
'    jRow = 5
'    Do While Worksheets("ProductDB").Range("B" & iRow).Value <> ""
'        If Worksheets("ProductDB").Range("C" & iRow).Value = Worksheets("Program").Range("C & jRow").Value Then
'            Worksheets("Program").Range("D" & jRow).Value = Worksheets("ProductDB").Range("D" & iRow).Value
'            Worksheets("Program").Range("E" & jRow).Value = Worksheets("ProductDB").Range("E" & iRow).Value
'            Exit Sub
'        End If
'        iRow = iRow + 1
'    Loop
    Dim rSource As Range
    Dim rs As Range
    Dim rTarget As Range
    Dim rt As Range
    Dim lng As Long
    With Sheets("ProductDB")
        Set rSource = .Range("C4", .Range("C" & Rows.Count) _
            .End(xlUp))
    End With
    With Sheets("Program")
        Set rTarget = .Range("C5", .Range("C" & Rows.Count) _
            .End(xlUp))
    End With
    For Each rt In rTarget
        For Each rs In rSource
            If rs = rt Then
                rt.Offset(0, 1) = rs.Offset(0, 1)
                rt.Offset(0, 2) = rs.Offset(0, 2)
                lng = lng + 1
            End If
        Next rs
    Next rt
    If lng = 0 Then
        MsgBox "ไม่พบรหัสสินค้าที่กำหนด", vbOKOnly
    End If
End Sub

[sanorte9]

ขอบคุณครับ จะลองนำ Code ไปศึกษาดู

แล้วกรณี รหัสที่ใส่ไปมันผิด เราสามารถแสดงใน MsgBox ได้ไหมว่าที่ผิดคือ รหัสนั้นๆ

เช่นใส่ไปว่า A100 แล้วกดปุ่ม จากนั้นพบว่าไม่มี A100 ใน ProductDB แล้วให้โช MsgBox ไม่พบ A100

ขอบคุณล่วงหน้าครับ

[snasui]

ลองปรับ Code มาดูก่อนครับ ติดตรงไหนสามารถถามกันได้เรื่อย ๆ ครับ