VBA บันทึกข้อมูลใน Sheets เดียวกัน

[NEO889]

สวัสดีครับผมเขียน VBA โดยสร้าง Module ขึ้นมา โดยผมเขียนโค้ดดังนี้ครับ

Code: Select all

Sub Record()
ActiveSheet.Unprotect Password:="3890" '<==UnProtect
If Range("R2") <> "" And Range("D2") <> "" And Range("K2") <> "" And Range("E4") <> "" And Range("N4") <> "" And Range("AE4") <> "" And Range("D7") And Range("C6") And Range("N6") And Range("AE6") And Range("E8") And Range("S8") Then
.Range("A11:BC11") _
.Range("BH11").Copy
.Range("A" & Rows.Count) _
    .End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
.Range("K2,S8") _
       .SpecialCells(xlCellTypeConstants).ClearContents
    MsgBox ("ºÑ¹·Ö¡¢éÍÁÙÅàÃÕºÃéÍÂ")
Else
    MsgBox ("¤Ø³ÂѧãÊè¢éÍÁÙÅäÁè¤Ãº")
    Range("R4").Activate
End If
ActiveSheet.Protect Password:="3890" '<==Protect Again
End Sub

มันไม่ผ่านให้ครับ ไม่แน่ว่าผิดพลาดตรงไหนหรือเปล่า

[snasui]

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

Code: Select all

Sub Record()
    With ActiveSheet
        .Unprotect Password:="3890" '<==UnProtect
        If .Range("R2") <> "" And .Range("D2") <> "" _
            And .Range("K2") <> "" And .Range("E4") <> "" _
            And .Range("N4") <> "" And .Range("AE4") <> "" _
            And .Range("D7") <> "" And .Range("C6") <> "" _
            And .Range("N6") <> "" And .Range("AE6") <> "" _
            And .Range("E8") <> "" And .Range("S8") <> "" Then
        .Range("A11", "BH11").Copy .Range("A" & .Rows.Count) _
            .End(xlUp).Offset(1, 0)
        .Range("K2,S8") _
               .SpecialCells(xlCellTypeConstants).ClearContents
            MsgBox ("บันทึกข้อมูลเรียบร้อย")
        Else
            MsgBox ("คุณยังใส่ข้อมูลไม่ครบ")
            .Range("R4").Activate
        End If
        .Protect Password:="3890" '<==Protect Again
    End With
End Sub

[NEO889]

โค้ดผ่านแล้วครับ แต่พอกดบันทึกแล้วข้อมูลไม่บันทึกลงตารางด้านล่างครับ

[DhitiBank]

ลองใส่คำสั่ง

Code: Select all

.Range("A" & Rows.Count) _
    .End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

เข้าไปไว้ที่เดิมครับ

[NEO889]

ขึ้น Errer ครับ

Code: Select all

Sub Record()
    With ActiveSheet
        .Unprotect Password:="3890" '<==UnProtect
        If .Range("R2") <> "" And .Range("D2") <> "" _
            And .Range("K2") <> "" And .Range("E4") <> "" _
            And .Range("N4") <> "" And .Range("AE4") <> "" _
            And .Range("C6") <> "" _
            And .Range("N6") <> "" And .Range("AE6") <> "" _
            And .Range("E8") <> "" And .Range("S8") <> "" Then
	.Range("A11:BH11").Copy .Range("A" & .Rows.Count) _
        .End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues _
        .Range("K2,S8").SpecialCells(xlCellTypeConstants).ClearContents
            MsgBox ("ºÑ¹·Ö¡¢éÍÁÙÅàÃÕºÃéÍÂ")
        Else
            MsgBox ("¤Ø³ÂѧãÊè¢éÍÁÙÅäÁè¤Ãº")
            .Range("R4").Activate
        End If
        .Protect Password:="3890" '<==Protect Again
    End With
End Sub

[DhitiBank]

Code: Select all

.Range("A11:BH11").Copy .Range("A" & .Rows.Count) _
        .End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues _
        .Range("K2,S8").SpecialCells(xlCellTypeConstants).ClearContents

ลองปรับเป็นแบบนี้ครับ

Code: Select all

.Range("A11:BH11").Copy 
.Range("A" & .Rows.Count) _
        .End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
.Range("K2,S8").SpecialCells(xlCellTypeConstants).ClearContents

[NEO889]

ยังติดอยู่ 2 ตัวแปรด้วยกันครับ ลองแก้ไขแล้วไม่ผ่านสักทีครับ


ขอบคุณครับ

[DhitiBank]

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

[DhitiBank]

อ๋อ ปัญหาเกิดจากการผสานเซลล์ครับ หากยังต้องการผสานเซลล์อยู่แบบนี้ ลองปรับโค้ดเป็นแบบนี้ครับ

Code: Select all

Sub Record()
    Dim i&
    With ActiveSheet
        .Unprotect Password:="3890" '<==UnProtect
        If .Range("R2") <> "" And .Range("D2") <> "" _
            And .Range("K2") <> "" And .Range("E4") <> "" _
            And .Range("N4") <> "" And .Range("AE4") <> "" _
            And .Range("D7") <> "" And .Range("C6") <> "" _
            And .Range("N6") <> "" And .Range("AE6") <> "" _
            And .Range("E8") <> "" And .Range("S8") <> "" Then
        i = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Row
        .Range("a" & i).Value = .Range("a11").Value
        .Range("b" & i).Value = .Range("b11").Value
        '.......
        '.......
        
        .Range("K2,S8") _
               .SpecialCells(xlCellTypeConstants).ClearContents
            MsgBox ("บันทึกข้อมูลเรียบร้อย")
        Else
            MsgBox ("คุณยังใส่ข้อมูลไม่ครบ")
            .Range("R4").Activate
        End If
        .Protect Password:="3890" '<==Protect Again
    End With
End Sub

ตรงที่เป็น '..... หมายถึงให้ใส่ต่อนะครับ โดยทำรูปแบบคล้ายๆ กับแถวที่อยู่ก่อนหน้านั้น แล้วลองรันดูว่าผ่านไหม

[NEO889]

โค้ดผ่านครับไม่ขั้น Ererr แต่ข้อมูลยังไม่มาเหมือนเดิม ต้องใช้คำสั่ง .copy ด้วยใช่ไหมครับ

Code: Select all

Sub Record()
    Dim i&
    With ActiveSheet
        .Unprotect Password:="3890" '<==UnProtect
        If .Range("R2") <> "" And .Range("D2") <> "" _
            And .Range("K2") <> "" And .Range("E4") <> "" _
            And .Range("N4") <> "" And .Range("AE4") <> "" _
            And .Range("C6") <> "" _
            And .Range("N6") <> "" And .Range("AE6") <> "" _
            And .Range("E8") <> "" And .Range("S8") <> "" Then
        i = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Row
        .Range("a" & i).Value = .Range("a11").Value
        .Range("b" & i).Value = .Range("b11").Value
        .Range("c" & i).Value = .Range("E11").Value
        .Range("d" & i).Value = .Range("W11").Value
        .Range("e" & i).Value = .Range("AH11").Value
        .Range("F" & i).Value = .Range("AS11").Value
        .Range("G" & i).Value = .Range("AX11").Value
        .Range("H" & i).Value = .Range("BC11").Value
               .Range("K2,S8") _
               .SpecialCells(xlCellTypeConstants).ClearContents
            MsgBox ("ºÑ¹·Ö¡¢éÍÁÙÅàÃÕºÃéÍÂ")
        Else
            MsgBox ("¤Ø³ÂѧãÊè¢éÍÁÙÅäÁè¤Ãº")
            .Range("R4").Activate
        End If
        .Protect Password:="3890" '<==Protect Again
    End With
End Sub

[DhitiBank]

ข้อมูลไม่มาแน่นอนครับ เพราะจากโค้ด ข้อมูลต้นทางจะอยู่ที่ A11:BG11 แต่เมื่อไม่มีข้อมูลอะไรอยู่ คำสั่งก็คัดลอกเพียงค่าว่างๆ ไปครับ
เท่าที่ดูคุณสมบัติของ A11:BG11 คุณได้ล็อคเซลล์เอาไว้ แสดงว่าจะเอาไว้ใช้ดึงข้อมูลจากรายการให้เลือกด้านบนใช่หรือไม่ครับ หากใช่ คุณก็ต้องใส่สูตรดึงข้อมูลขณะที่ผู้ใช้งานกำลังคีย์ข้อมูลก่อน ดึงเอามาไว้ในตารางแถวที่ 11 นี้ จากนั้นพอรันโค้ดแล้ว ค่าต่างๆ ถึงไปอยู่ในตารางด้านล่างครับ

และอีกอย่าง คำสั่งต้นทางและปลายทางยังคลาดเคลื่อนอยู่ครับ ผมลองปรับมาเล็กน้อยตามไฟล์แนบครับ

[NEO889]

ขอบคุณครับ ใช้งานได้เลยครับ

[snasui]

โค้ดผ่านแล้วครับ แต่พอกดบันทึกแล้วข้อมูลไม่บันทึกลงตารางด้านล่างครับ

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