สอบถามโค้ดการเติม เครื่องหมาย / ลงในเซล

[tigerwit]

Code: Select all

 Sub FillColumn()
 Dim lastRow As Long
lastRow = Application.CountIf(Range("d2:d" & Cells(Rows.Count, 4).End(xlUp).Row), ">""")
    ActiveCell.Resize(lastRow, 1).Select
    Selection.Value = "/"
    Range("G7").Select
     End Sub

จากไฟล์ที่แนบมา ต้องการคลิกปุ่มเช็คเวลา แล้วให้เติม / ลงในช่องแรกที่เลือกไว้ ลงไปจนถึงแถวที่มีข้อมูลคนสุดท้าย
แล้วให้เคอร์เซอร์กระโดดไปอยู่ที่เซลแรก ในช่องถัดไป
ตัวอย่างเช่น
เริ่มต้น เลือก F7 แล้วคลิก เช็คเวลาเรียน จะเติม / ลงไปถึง F23
จากนั้นให้เคอร์เซอร์กระโดดไปอยู่ที่ เซล G7
พอคลิก เช็คเวลาเรียนอีกครั้ง ก็จะเติม / ลงไปแล้วถึง G23
แล้วเคอร์เซอร์กระโดดไปอยู่ที่ H7
เป็นแบบนี้ไปต้องเพิ่มโค้ดอย่างไรครับ

[snasui]

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

Code: Select all

Sub FillColumn()
    Dim lastRow As Long
    With Worksheets("Time")
    '    lastRow = Application.CountIf(Range("d2:d" & Cells(Rows.Count, 4).End(xlUp).Row), ">""")
        lastRow = .Range("d" & .Rows.Count).End(xlUp).Row
'        ActiveCell.Resize(lastRow, 1).Select
'        Selection.Value = "/"
        .Range(.Cells(Selection.Row, Selection.Column), .Cells(lastRow, Selection.Column)).Value = "/"
'        Range("G7").Select
        Selection.Offset(0, 1).Select
    End With
End Sub

[tigerwit]

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

Code: Select all

Sub FillColumn()
    Dim lastRow As Long
    With Worksheets("Time")
    '    lastRow = Application.CountIf(Range("d2:d" & Cells(Rows.Count, 4).End(xlUp).Row), ">""")
        lastRow = .Range("d" & .Rows.Count).End(xlUp).Row
'        ActiveCell.Resize(lastRow, 1).Select
'        Selection.Value = "/"
        .Range(.Cells(Selection.Row, Selection.Column), .Cells(lastRow, Selection.Column)).Value = "/"
'        Range("G7").Select
        Selection.Offset(0, 1).Select
    End With
End Sub

ไม่หยุดที่แถวสุดท้ายที่มีรายชื่อ
ผมลองปรับแก้ดูแล้วตามนี้

Code: Select all

 Sub FillColumn2()
 ' Codeที่กำลังปรับแก้
     Dim lastRow As Long
    With Worksheets("Time")
        lastRow = Application.CountIf(Range("d2:d" & Cells(Rows.Count, 4).End(xlUp).Row), ">""")
        ActiveCell.Resize(lastRow, 1).Select
        Selection.Value = "/"
'        .Range(.Cells(Selection.Row, Selection.Column), .Cells(lastRow, Selection.Column)).Value = "/"
'        Range("G7").Select
        Selection.Offset(0, 1).Select
    End With
End Sub

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

[snasui]

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

Code: Select all

'Other code
Selection.Cells(1).Offset(0, 1).Select
'Other code

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

Code: Select all

Sub FillColumn()
    Dim lastRow As Long
    Dim i As Long, r As Range, j As Long
    With Worksheets("Time")
        Set r = .Range("d7")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
        Loop
        lastRow = r.Offset(i - 1, 0).Row
        If Selection.Row <= lastRow Then
            .Range(Selection, .Cells(lastRow, Selection.Column)).Value = "/"
            Selection.Offset(0, 1).Select
        End If
    End With
End Sub

[tigerwit]

ขอบคุณครับ
เรียนถามต่อว่า
กรณีที่เมื่อเช็คเวลาไปแล้วจนถึงคลอลัมน์สุดท้าย
และคลอลัมน์ถัดไปจะเป็นสูตร Sum เวลาเรียนทั้งหมดและล็อคเซลไว้อยู่
จะเขียนโค๊ดไม่ให้โดดไปคลอลัมน์ที่มีสูตรหรือคลอลัมน์ที่ถูกล็อคเซลไว้ครับ
จากไฟล์ที่แนบ คือไม่ให้โดดไปที่ เซล AT7

[snasui]

ตรวจสอบการ Locked ได้ครับ

if x.locked then exit sub

ลองนำไปปรับใช้ดูก่อน ติดแล้วค่อยนำสิ่งที่ปรับแล้วมาถามกันต่อครับ

[tigerwit]

สวัสดีครับพึ่งกลับมาจากออกทริปส์ ได้การบ้าน

Code: Select all

:D ตรวจสอบการ Locked ได้ครับ
if x.locked then exit sub

ด้วยความไม่รู้ จึงได้พยายามด้นสด ดั้นเมฆ สุดท้ายจนปัญหา
ก็ยังไม่ได้ได้อยู่ดี

Code: Select all

Sub FillColumn2()
    Dim lastRow As Long
    Dim i As Long, r As Range, j As Long
    With Worksheets("Time")
        Set r = .Range("d7")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
        Loop
          lastRow = r.Offset(i - 1, 0).Row
        If Selection.Row <= lastRow Then
            .Range(Selection, .Cells(lastRow, Selection.Column)).Value = "/"
            Selection.Offset(0, 1).Select
            If Range(Selection, .Cells(lastRow, Selection.Column)).Locked = True Then Exit Sub
        End If
    End With
End Sub

รบกวนให้คำแนะนำเพิ่มอีกสักนิดครับ

[snasui]

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

Code: Select all

'Other code...
If Selection.Row <= lastRow Then
    .Range(Selection, .Cells(lastRow, Selection.Column)).Value = "/"
    If Selection.Offset(0, 1).Locked Then Exit Sub
    Selection.Offset(0, 1).Select
'    If Range(Selection, .Cells(lastRow, Selection.Column)).Locked = True Then Exit Sub
End If
'Other code...

[tigerwit]

ขอบคุณครับ