สอบถามการตั้งมาโคร เพื่อขยับข้อมูลในเซลครับ

[TkaewchoosilpK]

สอบถามการตั้งมาโคร เพื่อขยับข้อมูลในเซลครับ โดยที่ข้อมูลเก่าในเซลไม่หายครับ
สมมุติว่า ผมเริ่มบันทึกข้อมูลที่ E4-5, F4-5, G4-5 (ทั้ง 6 เซลเป็นข้อมูลชุดเดียวกัน)
ผมต้องการตั้งค่ามาโครให้ เลื่อนข้อมูลจาก E4-5, F4-5, G4-5 ไปที่ H4-5,I4-5,J4-5
เพื่อที่จะได้ บันทึกข้อมูลชุดใหม่ ลงไปที่ E4-5, F4-5, G4-5 ครับ
อยากสอบถามท่านที่รู้ หรือไกด์เป็นแนวทีครับ
ขอบคุณครับ

[logic]

มีไฟล์ที่ลองเขียนมาเองแล้วไหมครับ ถ้ามีแนบมาด้วยเพื่อน ๆ จะได้สะดวกในการช่วยเหลือ

การแนบไฟล์อ่านกฎข้อ 4 และ 5 ของบนด้านบนของหน้านี้ก่อนด้วยนะครับ

[TkaewchoosilpK]

ไฟล์เดิมมีขนาดใหญ่เกินที่จะแนบในนี้ครับ
ที่ผมต้องการสอบถามคือ ข้อมูลสินค้าตัว ลำดับ 1 จะเริ่มบันทึกข้อมูลที่ E4-5, F4-5, G4-5
พอต้องการอัพเดท สินค้า ลำดับ 1 ก็จะให้เลื่อนข้อมูลชุดเดิม ไปที่ H4-5,I4-5,J4-5 ครับ
และข้อมูลสินค้า ลำดับที่ 2-n ก็จะเริ่มต้นทีแถว E-F-G เหมือนกันครับ
ขอบคุณครับ

[snasui]

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

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

[TkaewchoosilpK]

คำสั่งย้ายข้อมูล อยู่ในปุ่มสีฟ้าครับ
ตอนนี้คือ Code ที่ผมใช่ครับ

Private Sub CommandButton1_Click()
Sheets("Sheet1").Range("E4:E5").Select
Range(Selection, Selection.End(xlToRight)).Copy
Sheets("Sheet1").Range("H4:H5").PasteSpecial xlPasteValues
Range("E4:G5").ClearContents
End Sub

ที่ผมอยากสอบผมคือ Code นี้ เป็น Code สำหรับ รายการสินค้าที่ 1
ผมต้องปรับ Code ยังไงใหห้สามารถใช้ได้กับ สินค้า รายการที่ n ครับ
(เช่นถ้าต้องการบันทึกข้อมูลใหม่ของรายการที่ n ก็ให้ Select ช่วง E(n+4):E(n+5)
และไป paste ที่ H(n+4):H(n+5) )

*ผมไม่มีความรู้พื้นฐานทางด้านนี้เลยครับ ศึกษาจากการ search จาก google
**ขอบคุณครับ

บันทึกข้อมูล3.xlsm

[logic]

การวางโค้ดให้ทำตามกฎข้อ 5 ของบอร์ดด้านบนของหน้านี้ครับ

ลองดูโค้ดนี้ว่าทำงานได้ไหมครับ

Code: Select all

Private Sub CommandButton1_Click()
    Dim RowCount As Integer, CopyRange As Range
    Dim StartRow As Integer, LastRow As Integer
    Dim RowHigh As Integer, ColumnWidth As Integer
    With Worksheets("Sheet1")
        RowHigh = 2
        ColumnWidth = 3
        StartRow = .Range("A4").Row
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For RowCount = StartRow To LastRow Step 2
            Set CopyRange = .Range(.Cells(RowCount, "E"), _
                .Cells(RowCount, "XFD").End(xlToLeft)).Resize(RowHigh)
            CopyRange.Copy
            .Range("H" & RowCount).PasteSpecial xlPasteValues
            CopyRange.Resize(RowHigh, ColumnWidth).ClearContents
        Next RowCount
    End With
End Sub

[TkaewchoosilpK]

การวางโค้ดให้ทำตามกฎข้อ 5 ของบอร์ดด้านบนของหน้านี้ครับ

ลองดูโค้ดนี้ว่าทำงานได้ไหมครับ

Code: Select all

Private Sub CommandButton1_Click()
    Dim RowCount As Integer, CopyRange As Range
    Dim StartRow As Integer, LastRow As Integer
    Dim RowHigh As Integer, ColumnWidth As Integer
    With Worksheets("Sheet1")
        RowHigh = 2
        ColumnWidth = 3
        StartRow = .Range("A4").Row
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For RowCount = StartRow To LastRow Step 2
            Set CopyRange = .Range(.Cells(RowCount, "E"), _
                .Cells(RowCount, "XFD").End(xlToLeft)).Resize(RowHigh)
            CopyRange.Copy
            .Range("H" & RowCount).PasteSpecial xlPasteValues
            CopyRange.Resize(RowHigh, ColumnWidth).ClearContents
        Next RowCount
    End With
End Sub

ของคุณ logic ผมใส่แล้ว เวลากดปุ่ม มันเลื่อนไปทุก รายการสินค้าเลยครับ
ผมต้องการแค่ เลื่อนข้อมูล ของสินค้ารายการที่จะอัพเดท เช่นจะอัพเดท รายการที่ 1 ก็นำเมาส์ไป select บน E4 (ซึ่งเป็นเซลแรกในการบันทึกข้อมูล) พอกดปุ่มสีฟ้า ก็ให้ Select ข้อมูล แถวล่าง E4 1แถว และ ทุกเซลในขวาที่มีข้อมูล ให้ขยับไป 3 ช่อง ครับ (ผมอาจจะอธิบายยากเพราะผมไม่ค่อยทราบคำศัพท์ครับ ขออภัยตรงนี้ด้วยครับ)
*ขอบคุณครับ

[DhitiBank]

ลองปรับโค้ดแบบนี้ดูครับ

Code: Select all

Private Sub CommandButton1_Click()
    Dim CopyRange As Range
    Set CopyRange = Selection
    If Len(Trim(Cells(CopyRange.Row, "a"))) > 0 Then
        Set CopyRange = Cells(CopyRange.Row, "e")
    Else
        Set CopyRange = Cells(CopyRange.Row - 1, "e")
    End If
    CopyRange.Select
    If Len(Trim(CopyRange.Value)) = 0 Then Exit Sub
    Set CopyRange = Range(CopyRange, CopyRange.End(xlToRight))
    Set CopyRange = CopyRange.Resize(2, CopyRange.Columns.Count)
    CopyRange.Copy CopyRange.Offset(0, 3)
    CopyRange.Resize(2, 3).ClearContents
End Sub

[TkaewchoosilpK]

ลองปรับโค้ดแบบนี้ดูครับ

Code: Select all

Private Sub CommandButton1_Click()
    Dim CopyRange As Range
    Set CopyRange = Selection
    If Len(Trim(Cells(CopyRange.Row, "a"))) > 0 Then
        Set CopyRange = Cells(CopyRange.Row, "e")
    Else
        Set CopyRange = Cells(CopyRange.Row - 1, "e")
    End If
    CopyRange.Select
    If Len(Trim(CopyRange.Value)) = 0 Then Exit Sub
    Set CopyRange = Range(CopyRange, CopyRange.End(xlToRight))
    Set CopyRange = CopyRange.Resize(2, CopyRange.Columns.Count)
    CopyRange.Copy CopyRange.Offset(0, 3)
    CopyRange.Resize(2, 3).ClearContents
End Sub

ขอบคุณครับ คุณ DhitiBank ใช้ได้ตรงตามความต้องการเลยครับ
*ผมจะพยายามนำไปประยุกต์ใช้กับงานอื่นๆครับ