การเรียกข้อมูลมาแก้ไข

[sakajohn]

ขอรบกวนสอบถามปัญหาครับ คือ ผมมี Sheet 3 แผ่น 1. Sheet Entry ไว้สำหรับกรอกข้อมูลต่างๆ เมื่อกรอกครบ ก็คลิ๊กที่ปุ่มบันทึกข้อมูล โดยมีข้อแม้ว่า เลข JINMAO CODE ต้องไม่ซ๊ำกัน เมื่อบันทึกแล้วข้อมูลจะไปอยู่ใน Sheet Data โดยเรียงลำดับลงมาเรื่อยๆ 2. Sheet EDIT เอาไว้สำหรับ เรียกข้อมูลที่อยู่ใน Sheet DATA ขึ้นมาแก้ไข ความต้องการของผมคือ 1. ถ้าข้อมูลที่แก้ไขมี JINMAO CODE เหมือนเดิมก็ให้บันทึกลงไปในSheet DATA ที่ตำแหน่งเดิม(ทับลงไปได้) 2. ถ้า JINMAO CODE มีการแก้ไขใหม่ ให้บันทึกใน Sheet DATA โดยให้ข้อมูลต่อลงมาในบรรทัดถัดไป ผมใช้Vlookup ในการเรียกข้อมูล แต่พอไปแก้ไขรายละเอียด มันก็จะลบสูตรไปด้วย เลยขอรบกวนช่วยแนะนำวิธีด้วยครับ

[snasui]

Code ที่เขียนมาเองแล้วนั้นอยู่ใน Module ใด ติดขัดบรรทัดใด ช่วยแจ้งมาด้วยทุกครั้งจะได้เข้าถึงปัญหาได้โดยไวครับ

[sakajohn]

Code ที่เขียนมาเองแล้วนั้นอยู่ใน Module ใด ติดขัดบรรทัดใด ช่วยแจ้งมาด้วยทุกครั้งจะได้เข้าถึงปัญหาได้โดยไวครับ

ตอนนี้ผมลองปรับใหม่ครับ โดยในSheet EDIT ผมเพิ่มตารางขึ้นมาทางขวามือโดยใช้สูตร Vlookup ให้ดึงข้อมูลมาก่อน จากนั้นเขียนMACRO ใน Module 9 โดยให้ COPY และ PASTE ค่าจากตารางทางขวามือไปลงตามช่องที่กำหนดทางซ้ายมือ จากนั้นเราสามารถแก้ไขข้อมูลต่างๆได้ แต่มีข้อกำหนดคือ ค่า JINMAO CODE ต้องไม่ซ๊ำกัน พอกดปุ่มบันทึกข้อมูล ค่าก็จะบันทึกลงใน SHEET DATA ต่อท้ายไปเรื่อยๆ แล้วก็ให้ Clear ข้อมูลในตารางซ้ายมือ ตอนนี้ใช้ได้แต่ผมรู้สึกว่ามันยังไม่ดีครับ ผมยังต้องการว่าถ้า Jinmao CODE ซ๊ำกันก็ให้บันทึกทับลงไปตรงจุดเดิมได้ด้วยครับ

[snasui]

ช่วยเขียนตำแหน่งเซลล์ที่จะนำไปวางใน Form ด้านซ้ายกำกับไว้ในคอลัมน์ R ของชีต EDIT ด้วยเพื่อสะดวกในการเขียน Code ครับ

ยกตัวอย่าง
ที่ R5 คีย์ G3
ที่ R6 คีย์ K3

เป็นต้น

จากนั้นแนบไฟล์กลับมาอีกครั้งครับ

[sakajohn]

ช่วยเขียนตำแหน่งเซลล์ที่จะนำไปวางใน Form ด้านซ้ายกำกับไว้ในคอลัมน์ R ของชีต EDIT ด้วยเพื่อสะดวกในการเขียน Code ครับ

ยกตัวอย่าง
ที่ R5 คีย์ G3
ที่ R6 คีย์ K3

เป็นต้น

จากนั้นแนบไฟล์กลับมาอีกครั้งครับ

ผมแนบไฟล์มาใหม่แล้วครับ โดยกำหนดว่าแต่ละค่าจะให้ไปวางไว้ที่ไหนครับ ขอบคุณมากครับ

[snasui]

ตัวอย่าง Code เมื่อนำข้อมูลไปวางใน Form ครับ

Code: Select all

Dim rall As Range
Dim r As Range
With Sheets("EDIT")
    Set rall = .Range("t3", .Range("t" & .Rows.Count).End(xlUp))
    For Each r In rall
        If r.Value <> "" Then
            .Range(r.Value).Value = r.Offset(0, -3).Value
        End If
    Next r
End With

ตัวอย่าง Code เมื่อนำข้อมูลจาก Form กลับไปวางในชีต Data

Code: Select all

Dim rall As Range
Dim r As Range
Dim numRow As Long
With Sheets("EDIT")
    Set rall = .Range("t3", .Range("t" & .Rows.Count).End(xlUp))
    For Each r In rall
        If r.Value <> "" Then
            r.Offset(0, 1).Value = .Range(r.Value).Value
        End If
    Next r
    rall.Offset(0, 1).Copy
    If Application.CountIf(Sheets("data").Range("a:a"), .Range("c3").Value) > 0 Then
        numRow = Application.Match(.Range("c3").Value, Sheets("Data").Range("a:a"), 0) - 1
        Sheets("Data").Range("a" & numRow).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Else
        Sheets("Data").Range("a" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, _
            Transpose:=True
    End If
End With

กรณีไม่ตรงช่องให้ลองจัดช่องในชีต EDIT คอลัมน์ P:T เสียใหม่ครับ

[sakajohn]

ตัวอย่าง Code เมื่อนำข้อมูลไปวางใน Form ครับ

Code: Select all

Dim rall As Range
Dim r As Range
With Sheets("EDIT")
    Set rall = .Range("t3", .Range("t" & .Rows.Count).End(xlUp))
    For Each r In rall
        If r.Value <> "" Then
            .Range(r.Value).Value = r.Offset(0, -3).Value
        End If
    Next r
End With

ตัวอย่าง Code เมื่อนำข้อมูลจาก Form กลับไปวางในชีต Data

Code: Select all

Dim rall As Range
Dim r As Range
Dim numRow As Long
With Sheets("EDIT")
    Set rall = .Range("t3", .Range("t" & .Rows.Count).End(xlUp))
    For Each r In rall
        If r.Value <> "" Then
            r.Offset(0, 1).Value = .Range(r.Value).Value
        End If
    Next r
    rall.Offset(0, 1).Copy
    If Application.CountIf(Sheets("data").Range("a:a"), .Range("c3").Value) > 0 Then
        numRow = Application.Match(.Range("c3").Value, Sheets("Data").Range("a:a"), 0) - 1
        Sheets("Data").Range("a" & numRow).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    Else
        Sheets("Data").Range("a" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, _
            Transpose:=True
    End If
End With

กรณีไม่ตรงช่องให้ลองจัดช่องในชีต EDIT คอลัมน์ P:T เสียใหม่ครับ

อาจารย์ครับ ผมขอสอบถามครับ CODE ที่อาจารย์ให้มาใหม่ผมต้องเอาไปใส่ที่ตรงไหนครับ รบกวนขอความรู้เพิ่มเติมด้วยครับ

[snasui]

ผมเขียนแจ้งไว้เรียบร้อยแล้วว่า Code ใดทำงานอะไร เดิมเขียนไว้เช่นไรก็ให้แทนด้วย Code นี้

ผมไม่ได้เขียน Sub และ End Sub ไปให้แสดงว่าให้เอาไปไว้ใน Sub เดิมได้เลย หากยังไม่มีก็ต้องสร้างขึ้นมาเองใหม่ จะใช้ชื่อใดก็แล้วแต่สะดวก

การจะนำ Code ไปวางต้องทำเองให้เป็น ไม่เช่นนั้นยังไม่ควรใช้ Code ครับ