ขอคำแนะนำการลงข้อมูลการจ่าย

[keay44]

สวัสดีค่ะรบกวนขอคำแนะนำในการเขียนโค๊ด VBA เนื่องจากตัวเอกสารที่ใช้ในการกรอกรายละเอียดค่อนข้างหลายชุด จึงอยากทำฟอร์มเพื่อคีย์ข้อมูลและให้ไปปรากฏใน sheet 2 ซึ่งอยากให้ข้อมูลในช่อง C1-C21 , E1-E21 ,G1-G21 พอกด save แล้วให้ไปปรากฎข้อมุลใน sheet1 เป็นแนวนอนและให้เรียงต่อกันเป็นแถวลงมาเรื่อยๆ ซึ่งไม่ให้หัวข้อตามข้อ A D F ให้คงอยู่เหมือนเดิม และต้องการให้ลงข้อมูลได้เพียง 500 บรรทัด เพื่อไม่ให้ไฟล์งานมีขนาดที่ใหญ่เนื่องจากการทำงานจะโหลดช้า เราสามารถปรับโค๊ดได้อย่างไรค่ะ

Code: Select all

Private Sub CommandButton1_Click()
    ActiveWorkbook.Save
    Range("C5:C12", ["E5:E12"]).Select
    Selection.Copy
    Sheets("Sheet2").Select
    ActiveSheet.Range("A1048576").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial xlPasteValues, Transpose:=True
    Sheets("Sheet1").Select
    Range("C13").Copy
    Sheets("Sheet2").Select
    ActiveSheet.Range("A1048576").End(xlUp).Offset(0, 20).Select
    Selection.PasteSpecial xlPasteValues
    Sheets("Sheet1").Select
    [B2:M15].ClearContents
End Sub

[snasui]

ตัวอย่าง Code ตามด้านล่าง ลองปรุงตามข้อมูลจริงครับ

Code: Select all

Private Sub CommandButton1_Click()
    Dim lastRow As Long
    lastRow = Worksheets("Sheet2").Range("a" & _
        Worksheets("Sheet2").Rows.Count).End(xlUp).Offset(1, 0).Row
    Range("C5:C12").Copy
    Worksheets("Sheet2").Range("a" & lastRow).PasteSpecial xlPasteValues, _
        Transpose:=True
    Range("E5:E12").Copy
    Worksheets("Sheet2").Range("t" & lastRow).PasteSpecial xlPasteValues, _
        Transpose:=True
    'Other code...
    Sheets("Sheet1").Range("C2:C12, E2:E12, G2:G12").ClearContents
    Application.CutCopyMode = False
End Sub

[keay44]

สวัสดีค่ะ ลองปรับโค๊ดแล้ว เพิ่มเติมในส่วนคอลัมภ์ G อยากสอบถามเพิ่มเติมว่าเราจะ
lock แถวให้ลงข้อมูลใน sheet 2 ได้เพียง 100 แถว หากเกินไม่สามารถคีย์เพิ่มได้ไหมค่ะ

Code: Select all

Private Sub CommandButton1_Click()
    Dim lastRow As Long
    lastRow = Worksheets("Sheet2").Range("a" & _
        Worksheets("Sheet2").Rows.Count).End(xlUp).Offset(1, 0).Row
    Range("C5:C21").Copy
    Worksheets("Sheet2").Range("a" & lastRow).PasteSpecial xlPasteValues, _
        Transpose:=True
    Range("E5:E21").Copy
    Worksheets("Sheet2").Range("q" & lastRow).PasteSpecial xlPasteValues, _
        Transpose:=True
    Range("G5:G21").Copy
    Worksheets("Sheet2").Range("ah" & lastRow).PasteSpecial xlPasteValues, _
        Transpose:=True
    Sheets("Sheet1").Range("C2:C21, E2:E21, G2:G21").ClearContents
    Application.CutCopyMode = False
End Sub

[snasui]

ตัวแปร lastRow เป็นการหาบรรทัดที่ต้องการวางข้อมูล นั่นแสดงว่าเราสามารถตรวจสอบตัวแปรนี้ได้ว่าถึงบรรทัดที่ 100 แล้วหรือไม่

การตรวจสอบสามารถใช้ฟังก์ชั่น If เข้ามาช่วยได้ครับ เช่น If lastRow > 100 Then Exit Sub ส่วนจะวางไว้ตรงไหนต้องลองเอง ติดตรงไหนค่อยถามกันต่อครับ

[keay44]

ขอบคุณมากๆค่ะ หนูลองทำได้แล้ว ไว้ติดขัดตรงไหนเพิ่มเติมจะขอคำแนะนำอีกนะค่ะ

[keay44]

ตัวแปร lastRow เป็นการหาบรรทัดที่ต้องการวางข้อมูล นั่นแสดงว่าเราสามารถตรวจอบตัวแปรนี้ได้ว่าถึงบรรทัดที่ 100 แล้วหรือไม่

การตรวจสอบสามารถใช้ฟังก์ชั่น If เข้ามาช่วยได้ครับ เช่น If lastRow > 100 Then Exit Sub ส่วนจะวางไว้ตรงไหนต้องลองเอง ติดตรงไหนค่อยถามกันต่อครับ

[keay44]

สวัสดีค่ะ ติดปัญหา หลังจากวางโค๊ดเพื่อไม่ให้บรรทัดคีย์เกิน 100 บรรทัด แต่หลังจากทำจริง ปรากฏว่า สามารถคีย์ต่อได้ที่บรรทัด 101
รบกวนขอคำแนะนำปรับโค๊ดหน่อยค่ะ

Code: Select all

Private Sub CommandButton1_Click()
    Dim lastRow As Long
    lastRow = Worksheets("Sheet2").Range("a" & _
        Worksheets("Sheet2").Rows.Count).End(xlUp).Offset(1, 0).Row
    Range("C5:C21").Copy
    Worksheets("Sheet2").Range("a" & lastRow).PasteSpecial xlPasteValues, _
        Transpose:=True
    Range("E5:E21").Copy
    Worksheets("Sheet2").Range("q" & lastRow).PasteSpecial xlPasteValues, _
        Transpose:=True
    Range("G5:G21").Copy
    Worksheets("Sheet2").Range("ah" & lastRow).PasteSpecial xlPasteValues, _
        Transpose:=True
    If lastRow > 100 Then Exit Sub
    Sheets("Sheet1").Range("C2:C21, E2:E21, G2:G21").ClearContents
    Application.CutCopyMode = False
    If lastRow > 100 Then Exit Sub
End Sub

[snasui]

ตัวอย่างการวาง Code การตรวจสอบบรรทัดต้องตรวจสอบหลังกำหนดค่าให้กับตัวแปรเลยครับ เช่น

Code: Select all

'Other code...
Dim lastRow As Long
lastRow = Worksheets("Sheet2").Range("a" & _
    Worksheets("Sheet2").Rows.Count).End(xlUp).Offset(1, 0).Row
if lastRow > 100 then exit sub
'Other code...
[/code

[keay44]

ขอบคุณค่ะ ลองทำดูนะค่ะหากติดปัญหาจะขอคำแนะนำอีกครั้งนะค่ะอาจารย์