สอบถามแนวทางการแยกข้อมูลบันทึก และบันทึกเฉพาะเซลล์ที่ม่ข้อมูลลงใน Sheet ด้วย macro ครับ

[pong4real]

รบกวนสอบถามครับ

1.ผมต้องการให้ macro ทำการบันทึกข้อมูลเฉพาะช่องที่มีการป้อนข้อมูลในฟอร์มเท่านั้น ลงใน Sheet Database

2.ผมต้องการให้ macro บันทึกแยก Sheet ถ้าในช่องนั้นของฟอร์มมีการป้อน Project code เป็น NP00003 ลงใน Sheet NP00003 ต่างหาก

ผิดผลาดประการใดต้องขออภัยด้วยนะครับ มือใหม่หัดโพส

Code: Select all

Sub btnSave_Click()

Sheets("Database").Select
Range("A1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("H4").Value

Sheets("Database").Select
Range("B1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("H5").Value

Sheets("Database").Select
Range("C1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("S5").Value

Sheets("Database").Select
Range("D1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("E8").Value

Sheets("Database").Select
Range("E1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("Q8").Value

Sheets("Database").Select
Range("F1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("V8").Value

Sheets("Database").Select
Range("G1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("AA8").Value

Sheets("Database").Select
Range("A1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("H4").Value

Sheets("Database").Select
Range("B1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("H5").Value

Sheets("Database").Select
Range("C1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("S5").Value

Sheets("Database").Select
Range("D1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("E10").Value

Sheets("Database").Select
Range("E1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("Q10").Value

Sheets("Database").Select
Range("F1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("V10").Value

Sheets("Database").Select
Range("G1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("AA10").Value

Sheets("Database").Select
Range("A1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("H4").Value

Sheets("Database").Select
Range("B1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("H5").Value

Sheets("Database").Select
Range("C1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("S5").Value

Sheets("Database").Select
Range("D1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("E12").Value

Sheets("Database").Select
Range("E1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("Q12").Value

Sheets("Database").Select
Range("F1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("V12").Value

Sheets("Database").Select
Range("G1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("AA12").Value

Sheets("Database").Select
Range("A1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("H4").Value

Sheets("Database").Select
Range("B1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("H5").Value

Sheets("Database").Select
Range("C1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("S5").Value

Sheets("Database").Select
Range("D1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("E14").Value

Sheets("Database").Select
Range("E1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("Q14").Value

Sheets("Database").Select
Range("F1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("V14").Value

Sheets("Database").Select
Range("G1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("AA14").Value

Sheets("Database").Select
Range("I1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("H4").Value

Sheets("Database").Select
Range("J1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("H5").Value

Sheets("Database").Select
Range("K1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("S5").Value

Sheets("Database").Select
Range("L1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("Q18").Value

Sheets("Database").Select
Range("M1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("Q20").Value

Sheets("Database").Select
Range("N1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("Q22").Value

Sheets("Database").Select
Range("O1").Select
Do Until ActiveCell.Value = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Value = Sheets("Form").Range("Q24").Value


End Sub

[snasui]

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

Code: Select all

Dim strRngs As String, r As Range, strSh As String
Dim l As Long, i As Integer, j As Integer, k As Long

strRngs = "H4,H5,S5,E#,Q#,V#,AA#"
With Worksheets("Form")
    For i = 8 To 14 Step 2
        j = 0
        If .Cells(i, "e").Value = "NP00003" Then
            strSh = "NP00003"
        Else
            strSh = "Database"
        End If
        With Worksheets(strSh)
            k = .Range("a" & .Rows.Count).End(xlUp).Row + 1
        End With
        For Each r In .Range(VBA.Replace(strRngs, "#", i))
            If .Cells(i, "e").Value = "" Then Exit Sub
            Worksheets(strSh).Range("a" & k).Offset(0, j).Value = r.Value
            j = j + 1
        Next r
    Next i
End With

[pong4real]

ทำได้แล้วครับ ขอบคุณมากครับที่ให้แนวทางการปรับ code

[pong4real]

สอบถามครับ แล้วถ้าอยากให้ 4 ช่องสุดท้ายของ Form ไปบันทึกใน Sheet ใหม่ ชื่อ worktime (เหมือนเงื่อนไขข้อ 1)
ต้องเพิ่ม Code ส่วนไหนบ้างครับ ขอบคุณครับ

[snasui]

ลองบันทึกมาเองก่อน นำไฟล์ตัวอย่างที่เขียนเองแล้วและยังติดปัญหามาถามกันต่อ ทำได้เท่าไรก็เท่านั้นแต่จะต้องทำมาเองก่อนเสมอครับ

[pong4real]

ผมรบกวนอาจารย์ช่วยดู code ให้ผมทีครับ ว่าทำไมเวลาป้อนข้อมูล แค่ 1-3 แถว พอกดบันทึกแล้ว มันไม่เคลียร์ข้อมูลให้เราครับ? แต่ถ้าป้อนข้อมูลครบทั้ง4 แถว(E#) มันค่อยเคลียร์ให้ครับ

ขอบคุณล่วงหน้าด้วยครับ.

Code: Select all

Sub btnSave_Click()

If Range("H5").Value = "" Then
    MsgBox "Please enter the person code", vbCritical
    
End If
    
Dim strRngs As String, r As Range, strSh As String
Dim l As Long, i As Integer, j As Integer, k As Long

strRngs = "H4,H5,S5,E#,Q#,V#,AA#"
With Worksheets("Form")
    For i = 8 To 14 Step 2
        j = 0
        
    If .Cells(i, "e").Value = "NP00003" Then
            strSh = "Non-Project"
        Else
            strSh = "Project"
    End If
   
    With Worksheets(strSh)
            k = .Range("a" & .Rows.Count).End(xlUp).Row + 1
    End With

        For Each r In .Range(VBA.Replace(strRngs, "#", i))
            If .Cells(i, "e").Value = "" Then Exit Sub
            Worksheets(strSh).Range("a" & k).Offset(0, j).Value = r.Value
            j = j + 1
        Next r
            Next i
            
    End With

    Selection.ClearContents
    Range("H5,E8,E10,E12,E14,Q8,Q10,Q12,Q14,V8,V10,V12,V14,AA8,AA10,AA12,AA14").Select
    Selection.ClearContents
    Range("ID").Select
        
End Sub

[snasui]

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

Code: Select all

'Other code
            For Each r In .Range(VBA.Replace(strRngs, "#", i))
                If .Cells(i, "e").Value = "" Then GoTo ClearContentsBeforEnd: 'Exit Sub
                Worksheets(strSh).Range("a" & k).Offset(0, j).Value = r.Value
                j = j + 1
            Next r
        Next i
    End With
ClearContentsBeforEnd:
    Selection.ClearContents
    Range("H5,E8,E10,E12,E14,Q8,Q10,Q12,Q14,V8,V10,V12,V14,AA8,AA10,AA12,AA14").Select
    Selection.ClearContents
    Range("ID").Select
End Sub

[pong4real]

ทำได้แล้วครับ ขอบคุณมากครับ

[pong4real]

ผมป้อนข้อมูลซักพักแล้วมันติดบัค ตามรูปภาพครับ
เป็นเพราะอะไรครับ

Code: Select all

Sub btnSave_Click()

If Range("H5").Value = "" Then
    MsgBox "Please enter the person code", vbCritical
    Exit Sub
End If
    
Dim strRngs As String, r As Range, strSh As String
Dim l As Long, i As Integer, j As Integer, k As Long

strRngs = "H4,H5,S5,E#,Q#,V#,AA#"
With Worksheets("Form")
    For i = 8 To 14 Step 2
        j = 0
        
    If .Cells(i, "e").Value = "NP00003" Then
            strSh = "Non-Project"
        Else
            strSh = "Project"
    End If
   
    With Worksheets(strSh)
            k = .Range("a" & .Rows.Count).End(xlUp).Row + 1
    End With

        For Each r In .Range(VBA.Replace(strRngs, "#", i))
                If .Cells(i, "e").Value = "" Then GoTo ClearContentsBeforEnd: 'Exit Sub
                Worksheets(strSh).Range("a" & k).Offset(0, j).Value = r.Value
                j = j + 1
            Next r
        Next i
    End With
ClearContentsBeforEnd:
    Selection.ClearContents
    Range("H5,E8,E10,E12,E14,Q8,Q10,Q12,Q14,V8,V10,V12,V14,AA8,AA10,AA12,AA14").Select
    Selection.ClearContents
    Range("ID").Select
    
End Sub

[snasui]

เกิดจากตอนที่มีการบันทึก Macro มีการเลือกเซลล์แล้ว Clear ค่าทิ้ง หากไม่ใช้แล้วก็ลบทิ้งหรือทำเป็น Comment ไปครับ