ต้องการให้ข้อมูลขึ้นColumn ใหม่โดยใช้ Macro

[imeaumm5]

สวัสดีค่ะ ต้องการสอบถามว่าจะทำอย่างไรให้ ข้อมูลในชีท "Form" ทำการขึ้นคอลัมน์ใหม่อัตโนมัติคะ
ตอนนี้ที่ทำได้คือ ต้องทำการคีย์เอง แล้วพอถึงแถวที่10 ข้อมูลก็จะไปเริ่มใหม่ที่ column C และ column D ค่ะ

ตอนนี้ได้ทำMacro การคีย์ข้อมูลในชีท "Test" แล้วให้มันมาอยู่ในชีท "Form" แต่อยากให้ข้อมูลถึงแค่แถวที่10 จากนั้นให้ข้อมูลรันใหม่ใน column C และ Column D แบบนี้ไปเรื่อยๆ ค่ะ รบกวนขอคำแนะนำด้วยนะคะ

Macroค่ะ

Code: Select all

 Sub Macro1()
'
' Macro1 Macro
'

'

     With Sheets("Form")
       
        lastrow = .Range("a" & .Rows.Count).End(xlUp).Row + 1
        
        .Range("a" & lastrow) = lastrow - 1
        
        .Range("a" & lastrow, .Range("b" & lastrow)).Value = _
            Sheets("TEST").Range("b2:c2").Value
        
    End With


    Sheets("TEST").Select
    Range("B2:C2").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B2").Select
End Sub 

และอันนี้เป็นคำสั่งที่ ให้เริ่มColumn ใหม่ (แต่ต้องคีย์เองที่ชีทนั้น)

Code: Select all

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Row >= 10 Then
    Cells(Target.Row - 8, Target.Column + 2).Select
    End If
End Sub

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

ขอบคุณสำหรับคำแนะนำล่วงหน้าค่ะ

[snasui]

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

Code: Select all

Sub Macro1()
'
' Macro1 Macro
'

'
     Dim lastCell As Range
     With Sheets("Form")
       Set lastCell = .UsedRange.Offset(1, 0).Find("*", _
            searchorder:=xlByColumns, searchdirection:=xlPrevious)
        
'        lastrow = .Range("a" & .Rows.Count).End(xlUp).Row + 1
        If lastCell Is Nothing Then
            lastrow = 2
            lastcol = 1
        ElseIf lastCell.Row >= 10 Then
            lastrow = 2
            lastcol = lastCell.Column + 1
        Else
            lastrow = lastCell.Row + 1
            lastcol = lastCell.Column - 1
        End If
        .Cells(lastrow, lastcol).Resize(1, 2).Value = Sheets("TEST").Range("b2:c2").Value
'        .Range("a" & lastrow) = lastrow - 1
        
'        .Range("a" & lastrow, .Range("b" & lastrow)).Value = _
            Sheets("TEST").Range("b2:c2").Value
    End With


    Sheets("TEST").Select
    Range("B2:C2").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("B2").Select
End Sub

[imeaumm5]

ลองเปลี่ยนโค้ดตามที่แนะนำมาใช้ได้แล้วนะคะ ขอบคุณมากเลยค่ะ แต่รบกวนอธิบาย โค้ดนี้ให้หน่อยได้ไหมคะ ว่าเป็นคำสั่งให้ทำอะไรหรอคะ

ขอบคุณสำหรับคำแนะนำล่วงหน้าค่ะ

Code: Select all

 Set lastCell = .UsedRange.Offset(1, 0).Find("*", _
            searchorder:=xlByColumns, searchdirection:=xlPrevious)

[Bo_ry]

Code: Select all

Sub Macro1()
Dim a, n&, r&, c&
      a = [B2:C2].Value2
     With Sheets("Form")
        n = Application.CountA(.[A2:Z10]) / 2
        r = n Mod 9 + 2
        c = Int(n / 9) * 2 + 1
        .Cells(r, c).Resize(, 2) = a
    End With
        [B2:C2].ClearContents
        [B2].Select
End Sub

[snasui]

ลองเปลี่ยนโค้ดตามที่แนะนำมาใช้ได้แล้วนะคะ ขอบคุณมากเลยค่ะ แต่รบกวนอธิบาย โค้ดนี้ให้หน่อยได้ไหมคะ ว่าเป็นคำสั่งให้ทำอะไรหรอคะ

ขอบคุณสำหรับคำแนะนำล่วงหน้าค่ะ

Code: Select all

 Set lastCell = .UsedRange.Offset(1, 0).Find("*", _
            searchorder:=xlByColumns, searchdirection:=xlPrevious)

เป็นการหาเซลล์สุดท้ายโดยไม่นับหัวคอลัมน์ครับ

การหาเซลล์สุดท้ายจะเริ่มหาไปทีละคอลัมน์เริ่มจากคอลัมน์ A เป็นต้นไปครับ

[imeaumm5]

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

รบกวนแนะนำให้หน่อยค่ะ
ขอบคุณล่วงหน้านะคะ

[snasui]

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

Code: Select all

'Other code
Dim lastCell As Range, s As String
s = Worksheets("Test").Range("d2").Value
With Sheets("Form")
   If s = "ชาย" Then
       Set lastCell = .Range("A3:F100000").Offset(1, 0).Find("*", _
           searchorder:=xlByColumns, searchdirection:=xlPrevious)
       If lastCell Is Nothing Then
           Set lastCell = .Range("a4")
           lastcol = 2
       End If
   Else
       Set lastCell = .Range("H3:Q100000").Offset(1, 0).Find("*", _
           searchorder:=xlByColumns, searchdirection:=xlPrevious)
       If lastCell Is Nothing Then
           Set lastCell = .Range("h4")
           lastcol = 9
       End If
   End If
   
'        lastrow = .Range("a" & .Rows.Count).End(xlUp).Row + 1
   
   If lastCell.Row = 4 Then
       lastrow = 4
       lastcol = lastCell.Column
       If lastCell.Value <> "" Then
           lastrow = lastrow + 1
           lastcol = lastCell.Column - 1
       End If
   ElseIf lastCell.Row >= 10 Then
       lastrow = 4
       lastcol = lastCell.Column + 1
   Else
       lastrow = lastCell.Row + 1
       lastcol = lastCell.Column - 1
   End If
'Other code

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