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 chính thức
Tham gia ngày
14 Tháng mười hai 2014
Bài viết
96
Được thích
5
Điểm
370
Tuổi
29
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

Lần chỉnh sửa cuối:

batman1

Thành viên gạo cội
Tham gia ngày
8 Tháng chín 2014
Bài viết
3,678
Được thích
5,678
Điểm
560
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ể".
 

tu205489039

Thành viên chính thức
Tham gia ngày
14 Tháng mười hai 2014
Bài viết
96
Được thích
5
Điểm
370
Tuổi
29
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 ạ
 

Ba Tê

Gội Rồi Mới Cạo
Tham gia ngày
5 Tháng năm 2009
Bài viết
11,719
Được thích
16,735
Điểm
1,860
Tuổi
61
Nơi ở
An Giang
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
 

be09

TNMT_Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
9,573
Được thích
9,348
Điểm
560
Tuổi
63
Nơi ở
Biên Hòa, Đồng Nai
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:

tu205489039

Thành viên chính thức
Tham gia ngày
14 Tháng mười hai 2014
Bài viết
96
Được thích
5
Điểm
370
Tuổi
29
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:

batman1

Thành viên gạo cội
Tham gia ngày
8 Tháng chín 2014
Bài viết
3,678
Được thích
5,678
Điểm
560
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:

tu205489039

Thành viên chính thức
Tham gia ngày
14 Tháng mười hai 2014
Bài viết
96
Được thích
5
Điểm
370
Tuổi
29
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 ạ
 

be09

TNMT_Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
9,573
Được thích
9,348
Điểm
560
Tuổi
63
Nơi ở
Biên Hòa, Đồng Nai
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

Lần chỉnh sửa cuối:

tu205489039

Thành viên chính thức
Tham gia ngày
14 Tháng mười hai 2014
Bài viết
96
Được thích
5
Điểm
370
Tuổi
29
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

Thành viên tích cực
Tham gia ngày
11 Tháng mười một 2016
Bài viết
1,075
Được thích
999
Điểm
360
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
 

tu205489039

Thành viên chính thức
Tham gia ngày
14 Tháng mười hai 2014
Bài viết
96
Được thích
5
Điểm
370
Tuổi
29
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 ạ.
 
Top Bottom