Code บันทึกข้อมูลนี้ ย่อได้หรือเปล่าครับ

[myjrcenter]

ผมต้องการบันทึกข้อมูลจากเซลล์ D3,D4,D5,D8,D11,D6,I3,I6,H2 ใน Sheet "ป้อนข้อมูล" ไปเก็บไว้ใน "รายงาน" ลองดัดแปลง Code แล้วได้ดังนี้

Code: Select all

Sub save()
    Sheets("ป้อนข้อมูล").Range("D3").Copy
    With Sheets("รายงาน")
        .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
      Sheets("ป้อนข้อมูล").Range("H2").Copy
    With Sheets("รายงาน")
        .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
    Sheets("ป้อนข้อมูล").Range("D11").Copy
    With Sheets("รายงาน")
        .Range("C" & .Range("C" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
    Sheets("ป้อนข้อมูล").Range("D6").Copy
    With Sheets("รายงาน")
        .Range("D" & .Range("D" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
    Sheets("ป้อนข้อมูล").Range("I3").Copy
    With Sheets("รายงาน")
        .Range("E" & .Range("E" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
    Sheets("ป้อนข้อมูล").Range("D4").Copy
    With Sheets("รายงาน")
        .Range("F" & .Range("F" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
    Sheets("ป้อนข้อมูล").Range("D5").Copy
    With Sheets("รายงาน")
        .Range("G" & .Range("G" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
    Sheets("ป้อนข้อมูล").Range("I6").Copy
    With Sheets("รายงาน")
        .Range("H" & .Range("H" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
     Sheets("ป้อนข้อมูล").Range("D8").Copy
    With Sheets("รายงาน")
        .Range("I" & .Range("I" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
    Range("D3").Select
ActiveWorkbook.save
End Sub

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

[snasui]

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

Code: Select all

Sub test()
    dim rngSource As Variant
    With Sheets("ป้อนข้อมูล")
        rngSource = Array(.Range("d3"), .Range("h2"), .Range("d11"), .Range("d6"), .Range("i3"), _
            .Range("d4"), .Range("d5"), .Range("i6"), .Range("d8"))
    End With
    With Sheets("รายงาน")
        .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 9).Value = rngSource
    End With
    Range("D3").Select
    ActiveWorkbook.save
End Sub

[myjrcenter]

อาจารย์ครับ มันขึ้น error อย่างนี้ครับ

[snasui]

แก้ rngSource As Variant เป็น dim rngSource As Variant ผมคีย์ตกไปครับ

[myjrcenter]

ได้แล้วครับ ขอบคุณมากครับอาจารย์

[DhitiBank]

ขอบคุณด้วยครับ เอาเรนจ์ที่อยู่กระจายๆ มาจัดเป็นอาร์เรย์ แล้วค่อยเอาไปใส่ในที่ที่ต้องการ ได้เทคนิคอีกแล้ว

[myjrcenter]

ได้คืบแล้วอยากได้ศอก รบกวนอีกนิดนะครับทั้งอาจารย์และท่านผู้รู้ ถ้าต้องการให้ตรวจสอบข้อมูลซ้ำใน Sheet "รายงาน" แล้วแจ้งเป็น MsgBox "ข้อมูลซ้ำ" ต้องเขียน Code ต่อยังไงครับ

[DhitiBank]

ลองเอา countif มาช่วยครับ เช่น

Code: Select all

Sub save()
    Dim rngSource As Variant
    Dim rngBase As Range
    Dim i As Integer
    With Sheets("รายงาน")
        Set rngBase = .Range("a1", .Range("a" & .Rows.Count).End(xlUp))
    End With
    With Sheets("ป้อนข้อมูล")
        i = Application.CountIf(rngBase, .Range("d3"))
        If i > 0 Then
            MsgBox "ทะเบียนซ้ำ ยกเลิกการบันทึก"
            Exit Sub
        End If
        rngSource = Array(.Range("d3"), .Range("h2"), .Range("d11"), .Range("d6"), .Range("i3"), _
            .Range("d4"), .Range("d5"), .Range("i6"), .Range("d8"))
    End With
    With Sheets("รายงาน")
        .Range("a" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 9).Value = rngSource
    End With
    Range("D3").Select
    ActiveWorkbook.save
End Sub

[myjrcenter]

ขอบคุณมากๆครับ ขอบคุณอาจารย์ทั้งสองท่านครับ ที่ช่วยตอบปัญหาให้คนความรู้น้อยอย่างผม ได้ใช้ในการงานประจำวัน ประหยัดเวลาและสะดวกขึ้นเยอะเลย ขอบคุณมากๆครับ

[DhitiBank]

ผมยังเป็นนักเรียนเหมือนกันครับ แล้วก็ขออภัยอาจารย์ด้วยครับ จริงๆ แล้วต้องให้เจ้าของกระทู้ปรับโค้ดมาเองก่อน คีย์เพลินไปหน่อย

[myjrcenter]

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