Giúp code để Insert dòng và copy dữ liệu xuống dựa vào số lượng cột D

Liên hệ QC

tu205489039

Thành viên hoạt động
Tham gia
14/12/14
Bài viết
110
Được thích
10
Giới tính
Nam
Dạ nhờ anh chị sửa giúp em đoạn code này này với ạ
Mã:
Sub a()
Dim i As Long, z As Long
Dim Row1 As Long, row2 As Long
Application.ScreenUpdating = False
row2 = [A1].End(xlDown).Row
Row1 = Cells(10000, 1).End(xlUp).Row
For i = Row1 To row2 Step -1
z = Cells(i, 4)
If z <> 1 Then
    With Cells(i, 1)
        If .Value <> "" Then
            .Resize(z - 1, 1).EntireRow.Insert
'           .Resize(z - 1, 4).Value = Sheet1.Range(Cells(i + z - 1, 2), Cells(i + z - 1, 4)).Value
            End If
    End With
End If
Next
Application.ScreenUpdating = True
End Sub
Mục đích em làm cái đoạn này là sau khi insert dòng thì dán lại dữ liệu của dòng bên dưới cho mấy dòng vừa insert xong.Insert thì em làm được rồi, nhưng đến đoạn
Mã:
'           .Resize(z - 1, 4).Value = Sheet1.Range(Cells(i + z - 1, 2), Cells(i + z - 1, 4)).Value
Thì em không biết phải làm sao để khoanh vùng lại vùng mới insert để dán cái dòng bên dưới lên. Loay hoay cả buổi mà không được
Em có gửi file đính kèm, dữ liệu gốc ở sheet1, kết quả mong muốn ở sheet2
Mong anh chị giúp đỡ, em cảm ơn!
 

File đính kèm

  • insert dòng và copy.xlsb
    19.2 KB · Đọc: 9
Lần chỉnh sửa cuối:
Hãy thêm Sheet2. Với dữ liệu ví dụ trong Sheet1 hãy nhập bằng tay vào Sheet2 kết quả cần có sau khi chạy code. Người khác không hiểu ý thì không giúp được.

Nên mô tả kỹ, và nhập kết quả mong đợi đề phòng trường hợp "em không biết mô tả như thế nào cho cụ thể".
 
Upvote 0
Hãy thêm Sheet2. Với dữ liệu ví dụ trong Sheet1 hãy nhập bằng tay vào Sheet2 kết quả cần có sau khi chạy code. Người khác không hiểu ý thì không giúp được.

Nên mô tả kỹ, và nhập kết quả mong đợi đề phòng trường hợp "em không biết mô tả như thế nào cho cụ thể".
dạ tại e cũng thử tách từng bước ở trên, ngăn bằng msgbox để coi biến chạy tới đâu rồi test thử, mà không biết phải khuya quá không mà càng mò càng lú :(. Em có up lại file thể hiện thêm kết quả mong muốn ở bên cạnh, Để mai e vọc tiếp xem thử. em cảm ơn anh nhiều ạ
 
Upvote 0
dạ tại e cũng thử tách từng bước ở trên, ngăn bằng msgbox để coi biến chạy tới đâu rồi test thử, mà không biết phải khuya quá không mà càng mò càng lú :(. Em có up lại file thể hiện thêm kết quả mong muốn ở bên cạnh, Để mai e vọc tiếp xem thử. em cảm ơn anh nhiều ạ
Bạn chạy thử Sub này xem có đúng với ý muốn của bạn không?
PHP:
Sub Gpe()
Dim i As Long, j As Long, n As Long, z As Long, k As Long, R As Long
Dim sArr(), dArr()
    sArr = Range("A4", Range("A10000").End(xlUp)).Resize(, 4).Value
    R = UBound(sArr)
ReDim dArr(1 To R * 10, 1 To 4)
    For i = 1 To R
        n = sArr(i, 4)
        For j = 1 To n
            k = k + 1
            For z = 1 To 4
                dArr(k, z) = sArr(i, z)
            Next z
        Next j
    Next i
Range("K4").Resize(10000, 4).ClearContents
Range("K4").Resize(k, 4) = dArr
End Sub
 
Upvote 0
Dạ nhờ anh chị sửa giúp em đoạn code này này với ạ
Mục đích em làm cái đoạn này là sau khi insert dòng thì dán lại dữ liệu của dòng bên dưới cho mấy dòng vừa insert xong.Insert thì em làm được rồi, nhưng đến đoạn
Mã:
'           .Resize(z - 1, 4).Value = Sheet1.Range(Cells(i + z - 1, 2), Cells(i + z - 1, 4)).Value
Thì em không biết phải làm sao để khoanh vùng lại vùng mới insert để dán cái dòng bên dưới lên. Loay hoay cả buổi mà không được
Mong anh chị giúp đỡ, em cảm ơn!
Góp ý cho bạn:
1/ Để giúp các thành viên thuận tiện trong việc tìm, kiếm bài viết liên quan: Bạn nên sửa tiêu đề cho rõ ràng hơn, tiêu đề có thể là "Giúp code để Insert dòng và copy dữ liệu xuống dựa và số lượng cột D".
2/ Bạn không nên đưa ra kết quả bên phải dữ liệu vì thực tế bạn có thể sử dụng nhiều hơn 4 cột. Vì vậy, bạn nên đưa kết quả sang Sheet2 là cách tốt nhất.
3/ Vấn đề của bạn có thể sử dụng 1 vòng lặp, nếu bạn sửa tiêu đề xong tôi sẽ gửi code lên. Ngoại trừ số lượng cột D thì bạn có thể thêm số lượng cột bao nhiêu là tùy ý (code vẫn thực hiện được hết) mà không cần phải sửa lại code.
 
Lần chỉnh sửa cuối:
Upvote 0
Góp ý cho bạn:
1/ Để giúp các thành viên thuận tiện trong việc tìm, kiếm bài viết liên quan: Bạn nên sửa tiêu đề cho rõ ràng hơn, tiêu đề có thể là "Giúp code để Insert dòng và copy dữ liệu xuống dựa và số lượng cột D".
2/ Bạn không nên đưa ra kết quả bên phải dữ liệu vì thực tế bạn có thể sử dụng nhiều hơn 4 cột. Vì vậy, bạn nên đưa kết quả sang Sheet2 là cách tốt nhất.
3/ Vấn đề của bạn có thể sử dụng 1 vòng lặp, nếu bạn sửa tiêu đề xong tôi sẽ gửi code lên. Ngoại trừ số lượng cột D thì bạn có thể thêm số lượng cột bao nhiêu là tùy ý (code vẫn thực hiện được hết) mà không cần phải sửa lại code.
dạ, em cảm ơn a đã góp ý. Em có chỉnh lại, mong anh chỉ giáo thêm giúp em, em cảm ơn anh nhiều ạ!
Bài đã được tự động gộp:

Bạn chạy thử Sub này xem có đúng với ý muốn của bạn không?
PHP:
Sub Gpe()
Dim i As Long, j As Long, n As Long, z As Long, k As Long, R As Long
Dim sArr(), dArr()
    sArr = Range("A4", Range("A10000").End(xlUp)).Resize(, 4).Value
    R = UBound(sArr)
ReDim dArr(1 To R * 10, 1 To 4)
    For i = 1 To R
        n = sArr(i, 4)
        For j = 1 To n
            k = k + 1
            For z = 1 To 4
                dArr(k, z) = sArr(i, z)
            Next z
        Next j
    Next i
Range("K4").Resize(10000, 4).ClearContents
Range("K4").Resize(k, 4) = dArr
End Sub
dạ, e thấy code chạy tốt rồi ạ. để em ngồi ngẫm lại đoạn code này. Em cảm ơn anh nhiều ạ
 
Lần chỉnh sửa cuối:
Upvote 0
Trong bài #1 thay
Mã:
.Resize(z - 1, 1).EntireRow.Insert
'           .Resize(z - 1, 4).Value = Sheet1.Range(Cells(i + z - 1, 2), Cells(i + z - 1, 4)).Value
bằng
Mã:
.Resize(z - 1, 1).EntireRow.Insert
Cells(i, 1).Resize(z - 1, 4).Value = Cells(i, 1).Offset(z - 1).Resize(1, 4).Value
Lưu ý:
- trong cụm With Cells(i, 1) không dùng được
.Resize(z - 1, 4).Value = .Offset(z - 1).Resize(1, 4).Value

mà phải dùng
Cells(i, 1).Resize(z - 1, 4).Value = Cells(i, 1).Offset(z - 1).Resize(1, 4).Value

Tại sao?

Giả sử i = 5, z = 4 (vòng lặp 1). Cho tới tận khi chèn 3 dòng thì "truy cập bắt đầu bằng dấu chấm" là truy cập vào phương thức hoặc thuộc tính cùa A5 = Cells(5, 1) = Cells(i, 1). Sau khi chèn 3 dòng thì A5 bị "đẩy" xuống tới dòng 8 cột 1. Do vậy sau khi chèn 3 dòng thì mọi "truy cập bắt đầu bằng dấu chấm" trong cụm With sẽ là truy cập vào phương thức hoặc thuộc tính cùa A8 = Cells(8, 1) = Cells(i+3, 1). Vì thế để khỏi tính toán rắc rối thì ta dùng
Cells(i, 1).Resize(z - 1, 4).Value = Cells(i, 1).Offset(z - 1).Resize(1, 4).Value
 
Lần chỉnh sửa cuối:
Upvote 0
Tại sao?

Giả sử i = 5, z = 4 (vòng lặp 1). Cho tới tận khi chèn 3 dòng thì "truy cập bắt đầu bằng dấu chấm" là truy cập vào phương thức hoặc thuộc tính cùa A5 = Cells(5, 1) = Cells(i, 1). Sau khi chèn 3 dòng thì A5 bị "đẩy" xuống tới dòng 8 cột 1. Do vậy sau khi chèn 3 dòng thì mọi "truy cập bắt đầu bằng dấu chấm" trong cụm With sẽ là truy cập vào phương thức hoặc thuộc tính cùa A8 = Cells(8, 1) = Cells(i+3, 1). Vì thế để khỏi tính toán rắc rối thì ta dùng
Cells(i, 1).Resize(z - 1, 4).Value = Cells(i, 1).Offset(z - 1).Resize(1, 4).Value
Đúng là cái đoạn này hôm qua làm em lú. cảm giác đi lạc giữa rừng u minh :( . Em cảm ơn a rất nhiều ạ
 
Upvote 0
Dạ nhờ anh chị sửa giúp em đoạn code này này với ạ
..............................................
Em có gửi file đính kèm, dữ liệu gốc ở sheet1, kết quả mong muốn ở sheet2
Mong anh chị giúp đỡ, em cảm ơn!
Bạn thử File theo góp ý ở bài 5.
Copy dữ liệu Paste vào Sheet1 rồi sang Sheet2 nhấn nút để xem kết quả.
 

File đính kèm

  • Insert Copy.xlsm
    20.8 KB · Đọc: 16
Lần chỉnh sửa cuối:
Upvote 0
Bạn thử File theo góp ý ở bài 5.
Copy dữ liệu Paste vào Sheet1 rồi sang Sheet2 nhấn nút để xem kết quả.
em cảm ơn a nhiều ạ, để e nguyên cứu thêm. hễ đụng vô offset hay resize cái e rối quá.
Mới đặt 2 cuốn cơ bản và nâng cao, hy vọng 1 ngày nào đó có thể theo kịp các anh :stretcher:
 
Upvote 0
em cảm ơn a nhiều ạ, để e nguyên cứu thêm. hễ đụng vô offset hay resize cái e rối quá.
Mới đặt 2 cuốn cơ bản và nâng cao, hy vọng 1 ngày nào đó có thể theo kịp các anh :stretcher:
Hoặc xem thêm cách củ chuối này
Mã:
Option Explicit
Sub InsertRow()
Dim sNum As Long, Lr As Long, Fr As Long, i As Long
Fr = [a1].End(xlDown).Row
Lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = Lr To Fr Step -1
    sNum = Cells(i, 4).Value
    If sNum > 1 Then
        Rows(i).Resize(sNum - 1).Insert
        Range("A" & i, "D" & i + sNum - 2).Value = Range("A" & i + sNum - 1, "D" & i + sNum - 1).Value
    End If
Next
End Sub
 
Upvote 0
Hoặc xem thêm cách củ chuối này
Mã:
Option Explicit
Sub InsertRow()
Dim sNum As Long, Lr As Long, Fr As Long, i As Long
Fr = [a1].End(xlDown).Row
Lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = Lr To Fr Step -1
    sNum = Cells(i, 4).Value
    If sNum > 1 Then
        Rows(i).Resize(sNum - 1).Insert
        Range("A" & i, "D" & i + sNum - 2).Value = Range("A" & i + sNum - 1, "D" & i + sNum - 1).Value
    End If
Next
End Sub
dạ, em cảm ơn anh ạ.
 
Upvote 0
Web KT
Back
Top Bottom