Snasui Excel Forum

คลังคำตอบแห่งความรู้จากคนไทย เพื่อโลกที่ต้องการเข้าใจในสิ่งเล็ก ๆ อย่างลึกซึ้ง
https://snasui.com/

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

https://snasui.com/viewtopic.php?t=19656

Page 1 of 1

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

Posted: Tue Dec 20, 2022 12:10 am
by 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

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

Posted: Tue Dec 20, 2022 11:06 am
by snasui
:D ตัวอย่างการปรับ 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

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

Posted: Fri Dec 23, 2022 2:59 pm
by pong4real
ทำได้แล้วครับ ขอบคุณมากครับที่ให้แนวทางการปรับ code

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

Posted: Fri Dec 23, 2022 4:12 pm
by pong4real
สอบถามครับ แล้วถ้าอยากให้ 4 ช่องสุดท้ายของ Form ไปบันทึกใน Sheet ใหม่ ชื่อ worktime (เหมือนเงื่อนไขข้อ 1)
ต้องเพิ่ม Code ส่วนไหนบ้างครับ ขอบคุณครับ

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

Posted: Fri Dec 23, 2022 4:34 pm
by snasui
:D ลองบันทึกมาเองก่อน นำไฟล์ตัวอย่างที่เขียนเองแล้วและยังติดปัญหามาถามกันต่อ ทำได้เท่าไรก็เท่านั้นแต่จะต้องทำมาเองก่อนเสมอครับ

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

Posted: Sat Feb 18, 2023 7:21 pm
by pong4real
:D ผมรบกวนอาจารย์ช่วยดู 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

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

Posted: Sat Feb 18, 2023 8:00 pm
by snasui
:D ตัวอย่างการปรับ 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

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

Posted: Sat Feb 18, 2023 8:14 pm
by pong4real
ทำได้แล้วครับ ขอบคุณมากครับ :thup:

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

Posted: Wed Feb 22, 2023 4:22 pm
by 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

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

Posted: Wed Feb 22, 2023 4:37 pm
by snasui
:D เกิดจากตอนที่มีการบันทึก Macro มีการเลือกเซลล์แล้ว Clear ค่าทิ้ง หากไม่ใช้แล้วก็ลบทิ้งหรือทำเป็น Comment ไปครับ
All times are UTC+07:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited