สอบถาม VBA ดึงข้อมูลจาก DATA ลำดับไม่ตรงกันครับ

[jakawan]

เรียนสอบถามครับ ผมได้ทำปุ่มเรียกดูข้อมูล จาก Sheet DATA ไปยัง Sheet Form โดยประยุกต์จากพี่ๆที่ให้ข้อมูลในบอร์ดนี้ จากการเลือกลำดับตามหมายเลข แต่ปรากฎว่า เมื่อผมเลือกลำดับ จะแสดงผลลัพธ์ ไม่ตรงกับที่เลือก เช่นเรียกดูข้อมูลหมายเลข 11 ข้อมูลที่แสดงจะเป็นข้อมูลของหมายเลข 9 ครับ เหมือนจะห่างกัน 2 ลำดับ ผมได้แนบไฟล์มาให้เพื่อขอความกรุณาช่วยเหลือด้วยครับ

[snasui]

ปรับ Code จาก r = Worksheets("Data").Cells(l, i) เป็น r = Worksheets("Data").Cells(l + 2, i) ครับ

[jakawan]

ขอบคุณครับอาจารย์ แล้วถ้าเราจะระบุให้ระบบหาลำดับหมายเลขเคสได้เลยมั้ยครับ เพราะตอนนี้มันจะเรียกดูตาม Cells ที่ตั้งไว้ครับ

[jakawan]

Code: Select all

Sub PreviewData()
Dim myRange As Range
Dim r As Range
Dim i As Integer
Dim j As Long
Dim l As Range
Set l = Worksheets("Input").Range("G10")

j = Worksheets("Database").Range("A1:BB1").Columns.Count

If l = 0 Then
    MsgBox "Not found data. Try again."
    Exit Sub
End If
    
Set myRange = Worksheets("Input").Range("C9, C10, C11, C12, C14, G14, L14, C15," & _
    "G15, L15, C16, L16, D17, F20, C21, C24,F24, I24, A29, A40, A47, C51, E51," & _
    "J66, A55, C55, D55, G55, J55, A57, C57,D57, G57, J57, A59, C59, D59, G59, J59, A61, C61, D61, G61, J61, A63, C63, D63, G63, J63, A65, C65, D65")
For Each r In myRange
    i = i + 1
    r = Worksheets("Database").Cells(l + 2, i)
Next r
MsgBox "Finish"
Range("C4").Locked = True
 End Sub

[jakawan]

เรียนสอบถามอาจารย์อีกประเด็นครับ ช่วงโค้ดนี้ เวลาผมเพิ่มเซลล์ เช่น G19 J17 หรือตัวอื่นๆแล้วจะขึ้น Code Eror 1004 ครับพอจะมีวิธีแก้ไหมครับ ขอบคุณครับ

Code: Select all

Set myRange = Worksheets("Input").Range("C9, C10, C11, C12, C14, G14, L14, C15," & _
    "G15, L15, C16, L16, D17, F20, C21, C24,F24, I24, A29, A40, A47, C51, E51," & _
    "J66, A55, C55, D55, G55, J55, A57, C57,D57, G57, J57, A59, C59, D59, G59, J59, A61, C61, D61, G61, J61, A63, C63, D63, G63, J63, A65, C65, D65")

[snasui]

แนบไฟล์ที่ Update ด้วย Code ด้านบนมาแล้ว จะได้ช่วยทดสอบได้ครับ

[jakawan]

รบกวนอาจารย์ด้วยนะครับ เหมือนที่มีอยู่ใส่ Cells ได้ไม่เกิน 52 Cells ถ้าเกินจะขึ้น Error ครับ ขอบคุณครับ

[jakawan]

โดย Cells ที่ใส่ทั้งหมดจะมี

Code: Select all

("C9", "C10", "C11", _
        "C12", "C14", "G14", "L14", "C15", "G15", _
        "L15", "C16", "G16", "L16", "D17", "J17", "C18", "E18", "G18", "I18", "K18", "C19", "G19", "C20", "F20", "J20", "L20", _
        "C21", "C24", "F24", "I24", "C25", "H25", "D26", "G26", "L26", "A29", _
        "A40", "A47", "C51", "E51", "H51", "C66", "j66", _
        "A55", "C55", "D55", "G55", "j55", _
        "A57", "C57", "D57", "G57", "j57", _
        "A59", "C59", "D59", "G59", "j59", _
        "A61", "C61", "D61", "G61", "j61", _
        "A63", "C63", "D63", "G63", "j63", _
        "A65", "C65", "D65", "G65", "j65")

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub PreviewData()
    Dim myRange As Variant
    Dim i As Integer
    Dim j As Long
    Dim l As Range
    Dim k As Integer
    Set l = Worksheets("Form").Range("A1")
    
    j = Worksheets("Data").Range("A1:AV1").Columns.Count
    
    If l = 0 Then
        MsgBox "Not found data. Try again."
        Exit Sub
    End If
    With Sheets("Form")
        myRange = Array("C9", "C10", "C11", "C12", "C14", "G14", "L14", "C15", "G15", "L15", "C16", _
            "L16", "D17", "F20", "C21", "C24", "F24", "I24", "A29", "A40", "A47", "C51", "E51", _
            "J66", "A55", "C55", "D55", "G55", "j55", "A57", "C57", "D57", "G57", "j57", "A59", "C59", "D59", "G59", _
            "j59", "A61", "C61", "D61", "G61", "j61", "A63", "C63", "D63", "G63", "j63", "A65", "C65", "D65", "G65", "j65")
            For k = 0 To UBound(myRange)
                i = i + 1
                .Range(myRange(k)).Value = Worksheets("Data").Cells(l + 2, i)
            Next k
    End With
    MsgBox "Finish"
    Range("C4").Locked = True
End Sub

[jakawan]

ได้แล้วครับ แต่ถ้าเราจะกำหนดให้เรียกข้อมูลตามลำดับหมายเลขเคสจริงๆ
เช่นลำดับที่ 20 อยู่ในCells ที่ 25 คำสั่งจะเรียกลำดับเคสที่อยู่ในCells ที่20 มาแทนครับ เหมือนเรียกตามแถว แต่ไม่ได้เรียกตามหมายเลขเคสนั้นจริงๆครับ พอที่จะมีวิธีระบุมั้ยครับ

ขอบคุณครับอาจารย์

[snasui]

ตามไฟล์ที่แนบมาและ Code ที่ผมตอบไปด้านบนหาตามลำดับใน A1ของชีท Form หากกรอก 20 จะได้หมายเลขเคสที่ 20 มาแสดง ถามด้วยไฟล์ไหนก็ควรอ้างอิงจากไฟล์นั้น จะได้เข้าใจตรงกันครับ

[jakawan]

ขอบคุณครับอาจารย์ อ้างอิงจากไฟล์เดิมครับ พอดีผมลองสลับลำดับกันใน ชีท Data ระหว่าง หมายเลข 19 กับ 20 เช่น 17 18 20 19 พอผมเรียกดูหมายเลข 19 ใน ชีท Form จะเป็นหมายเลข 20 ที่ขึ้นมาแสดงแทนครับ รบกวนอาจารย์ให้คำแนะนำด้วยครับ

[snasui]

หากเป็นเช่นนั้นให้เขียนการปรับ Code มาเองก่อน ติดตรงไหนแล้วค่อยถามกันต่อ ตัวอย่าง Code ลักษณะนั้นดูได้จาก Link เหล่านี้ครับ Application.Match

[jakawan]

ขอบคุณครับอาจารย์ผมจะนำกลับไปศึกษาและมาให้อาจารย์ดูใหม่ครับ

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

[snasui]

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

[jakawan]

แบบนี้ครับอาจารย์

Code: Select all

Sub ReplaceData()
Dim rs As Range
Dim rt As Range
Set rs = Worksheets("Input").Range("A1")
Set rt = Worksheets("Database").Range("A3").Offset
    Worksheets("Input").Range("A1"), 0)
If Worksheets("Input").Range("A3") = "" Then
    MsgBox "Can't replace data"
    Exit Sub
End If
rs.Copy: rt.PasteSpecial xlPasteValues
Application.CutCopyMode = False
MsgBox "Replace Complete"
End Sub
Application.CutCopyMode = False
MsgBox "Replace Complete"
End Sub

[snasui]

Code ที่เขียนมาไม่เกียวกับชีท Form และชีท Data

เขียนให้ตรงกับสิ่งที่จะทำจริง ไม่ใช่ยกเอา Code อื่นใดที่ไม่เกี่ยวข้องมาถามครับ

[jakawan]

ขอบคุณครับอาจารย์ตอนนี้ผมทำได้แล้วครับ โดยสร้าง Temp1 กับ Form1 และใช้ Code นี้ครับ

Code: Select all

Sub rdata()
Dim rs As Range
Dim rt As Range
Set rs = Worksheets("Temp1").Range("A4:CA4")
Set rt = Worksheets("Database").Range("A2").Offset( _
    Worksheets("Temp1").Range("CB2"), 0)
If Worksheets("Temp1").Range("A4") = "" Then
    MsgBox "Can't replace data"
    Exit Sub
End If
rs.Copy: rt.PasteSpecial xlPasteValues
Application.CutCopyMode = False
MsgBox "Replace Complete"
End Sub