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

tu205489039 · 21/11/20

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!

batman1 · 22/11/20

Hãy thêm Sheet2. Với dữ liệu ví dụ trong Sheet1 hãy nhập bằng tay vào Sheet2 kết quả cần có sau khi chạy code. Người khác không hiểu ý thì không giúp được.

Nên mô tả kỹ, và nhập kết quả mong đợi đề phòng trường hợp "em không biết mô tả như thế nào cho cụ thể".

tu205489039 · 22/11/20

batman1 đã viết:
Hãy thêm Sheet2. Với dữ liệu ví dụ trong Sheet1 hãy nhập bằng tay vào Sheet2 kết quả cần có sau khi chạy code. Người khác không hiểu ý thì không giúp được.

Nên mô tả kỹ, và nhập kết quả mong đợi đề phòng trường hợp "em không biết mô tả như thế nào cho cụ 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 ạ

Ba Tê · 22/11/20

tu205489039 đã viết:
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

be_09 · 22/11/20

tu205489039 đã viết:
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.

tu205489039 · 22/11/20

be09 đã viết:
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: 22/11/20

Ba Tê đã viết:

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 ạ

batman1 · 22/11/20

Trong bà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 ý:
- trong cụm With Cells(i, 1) không dùng được
.Resize(z - 1, 4).Value = .Offset(z - 1).Resize(1, 4).Value

mà phải dùng
Cells(i, 1).Resize(z - 1, 4).Value = Cells(i, 1).Offset(z - 1).Resize(1, 4).Value

Tại sao?

Giả sử i = 5, z = 4 (vòng lặp 1). Cho tới tận khi chèn 3 dòng thì "truy cập bắt đầu bằng dấu chấm" là truy cập vào phương thức hoặc thuộc tính cùa A5 = Cells(5, 1) = Cells(i, 1). Sau khi chèn 3 dòng thì A5 bị "đẩy" xuống tới dòng 8 cột 1. Do vậy sau khi chèn 3 dòng thì mọi "truy cập bắt đầu bằng dấu chấm" trong cụm With sẽ là truy cập vào phương thức hoặc thuộc tính cùa A8 = Cells(8, 1) = Cells(i+3, 1). Vì thế để khỏi tính toán rắc rối thì ta dùng
Cells(i, 1).Resize(z - 1, 4).Value = Cells(i, 1).Offset(z - 1).Resize(1, 4).Value

tu205489039 · 22/11/20

batman1 đã viết:
Tại sao?

Giả sử i = 5, z = 4 (vòng lặp 1). Cho tới tận khi chèn 3 dòng thì "truy cập bắt đầu bằng dấu chấm" là truy cập vào phương thức hoặc thuộc tính cùa A5 = Cells(5, 1) = Cells(i, 1). Sau khi chèn 3 dòng thì A5 bị "đẩy" xuống tới dòng 8 cột 1. Do vậy sau khi chèn 3 dòng thì mọi "truy cập bắt đầu bằng dấu chấm" trong cụm With sẽ là truy cập vào phương thức hoặc thuộc tính cùa A8 = Cells(8, 1) = Cells(i+3, 1). Vì thế để khỏi tính toán rắc rối thì ta dù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 ạ

be_09 · 24/11/20

tu205489039 đã viết:
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ả.

tu205489039 · 24/11/20

be09 đã viết:
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:

Nhattanktnn · 24/11/20

tu205489039 đã viết:
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

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

tu205489039 · 26/11/20

Nhattanktnn đã viết:

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 ạ.

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

tu205489039

Thành viên hoạt động

File đính kèm

batman1

Thành viên gạo cội

tu205489039

Thành viên hoạt động

Ba Tê

Cạo Rồi Khỏi Gội

be_09

Biên Hòa, Đồng Nai

tu205489039

Thành viên hoạt động

batman1

Thành viên gạo cội

tu205489039

Thành viên hoạt động

be_09

Biên Hòa, Đồng Nai

File đính kèm

tu205489039

Thành viên hoạt động

Nhattanktnn

Thành viên gắn bó

tu205489039

Thành viên hoạt động

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng