Copy dòng cách quãng (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

hongphuong1997

Thành viên tiêu biểu
Tham gia
12/11/17
Bài viết
773
Được thích
323
Giới tính
Nữ
Nhờ thầy cô và các bác viết giúp code copy dòng cách quãng như file đính kèm.
 

File đính kèm

File đính kèm

Bài này có nhiều bài lắm rồi mà.
Cho trước một mảng, rồi chèn số dòng trống xen vào.
Viết một hàm, đầu vào là mảng gốc và số dòng cần xen vào. (Lưu ý là dùng mảng thì hợp lý cho bài này).
Rồi còn đố viết 1 vòng lặp...
 
Bài này có thể giải quyết khi ta lập bảng sau:
Ta fải copy từ dòng 2 tới dòng 20 (2+ 18)
Copy từ dòng 3 tới dòng 29 (có nghĩa là 2 + 27)
v.v . . . . .
Mà các con số 18 = 2 * 9;
27 = 9 * 3

Ta có thể For . . . Next là được thôi.
 
Bài này có thể giải quyết khi ta lập bảng sau:
Ta fải copy từ dòng 2 tới dòng 20 (2+ 18)
Copy từ dòng 3 tới dòng 29 (có nghĩa là 2 + 27)
v.v . . . . .
Mà các con số 18 = 2 * 9;
27 = 9 * 3

Ta có thể For . . . Next là được thôi.
Cháu biết thì nào cũng có cao nhân mà,
Bác Viết giúp cháu với.
 
Đây là sự chiếu cố người có ảnh đẹp đó nha:
PHP:
Sub CopyCach2uang()
 Dim J As Long, Col As Integer
 
 Col = [B2].CurrentRegion.Columns.Count
 For J = 2 To 8
    Cells(J, "B").Resize(, Col).Copy Destination:=Cells(2 + 9 * J, "C")
    Cells(2 + 9 * J, "B").Value = J - 1
 Next J
End Sub
 
Đây là sự chiếu cố người có ảnh đẹp đó nha:
PHP:
Sub CopyCach2uang()
Dim J As Long, Col As Integer

Col = [B2].CurrentRegion.Columns.Count
For J = 2 To 8
    Cells(J, "B").Resize(, Col).Copy Destination:=Cells(2 + 9 * J, "C")
    Cells(2 + 9 * J, "B").Value = J - 1
Next J
End Sub
Con cảm ơn bác, để con xem đã nhé!
Bài đã được tự động gộp:

@hongphuong1997 sau loạt bài trả lời trên, bạn thử viết không dùng vòng lặp được không?
Hu hu... nhưng cháu chưa biết phương pháp đó bác ui.
Bác chỉ dẫn cho cháu với.
 
Nếu không dùng vòng lặp thi Hong Phuong viết vo tư
Cứ thế copy và Pasd có gì đâu.
Đó cũng là 1 cách hay, đỡ phải suy nghĩ nhiều. Nhưng ý mình đố ở đây khi dữ liệu lớn hơn hoặc chưa biết trước số dòng cột thì không copy paste được. Gợi ý 1 chút nhé, bạn tạo thêm cột phụ A, điền toàn số 1 đến 7 rồi lặp lại 8 lần. Sort theo cột phụ này rồi xóa cột phụ. Bây giờ làm sao để điền cột phụ mà không dùng vòng lặp?
 
Đó cũng là 1 cách hay, đỡ phải suy nghĩ nhiều. Nhưng ý mình đố ở đây khi dữ liệu lớn hơn hoặc chưa biết trước số dòng cột thì không copy paste được. Gợi ý 1 chút nhé, bạn tạo thêm cột phụ A, điền toàn số 1 đến 7 rồi lặp lại 8 lần. Sort theo cột phụ này rồi xóa cột phụ. Bây giờ làm sao để điền cột phụ mà không dùng vòng lặp?
Thế bạn làm thử cho mình coi xem nào?
Bài đã được tự động gộp:

Đây là sự chiếu cố người có ảnh đẹp đó nha:
PHP:
Sub CopyCach2uang()
Dim J As Long, Col As Integer

Col = [B2].CurrentRegion.Columns.Count
For J = 2 To 8
    Cells(J, "B").Resize(, Col).Copy Destination:=Cells(2 + 9 * J, "C")
    Cells(2 + 9 * J, "B").Value = J - 1
Next J
End Sub
Bác
SA_DQ

ui, bác ui,
Chuẩn không cần chỉnh Bác à
Con cảm ơn Bác nhé!
 
Lần chỉnh sửa cuối:

File đính kèm

Lần chỉnh sửa cuối:
Dạy ra những người không thực tiển; kĩ sự điện không biết ráp nối khởi động từ để nó làm việc
Thậm chí rất nhiều kĩ sư & cao đẵng mà mình tiếp nhận vô cơ quan không biết bao nhiêu % thán khí trong khí quyển.

Nói rõ hơn sẽ là: Ngành GD của chúng ta đang dạy cho con cháu những kiến thức mà người thầy, người cô có; Chứ không fải dạy những kiến thức mà XH đang cần
Mở rọng ra; Nền GD nước nhà chưa chuyển mình theo cơ chế thị trường
 
Lần chỉnh sửa cuối:
Bạn chạy code, nhập số dòng cần giãn cách vào inputbox.
(Trong code mình dùng mảng nhưng chỉ cần copy paste range là được).
Anh oy, anh viết gì vậy?
Các khoảng trống đó người ta đều có dữ liệu hết mớ
Anh insert như vậy để mất hết dữ liệu àh.
anh xem và làm lại đi anh nhé!
Hi hi hi....
 
Dạy ra những người không thực tiển; kĩ sự điện không biết ráp nối khởi động từ để nó làm việc
Thậm chí rất nhiều kĩ sư & cao đẵng mà mình tiếp nhận vô cơ quan không biết bao nhiêu % thán khí trong khí quyển.

Nói rõ hơn sẽ là: Ngành GD của chúng ta đang dạy cho con cháu những kiến thức mà người thầy, người cô có; Chứ không fải dạy những kiến thức mà XH đang cần
Mở rọng ra; Nền GD nước nhà chưa chuyển mình theo cơ chế thị trường
Em chỉ định đố vui thôi chứ có dạy gì đâu. Nhưng code cũng không phải vô dụng, trong trường hợp tổng quát nếu có nhiều dòng thì copy từng dòng sẽ làm chương trình chạy chậm. Tất nhiên do đố vui nên em làm thế, còn thường cột phụ sẽ dùng vòng lặp để gán vào mảng rồi copy vào sheet sẽ nhanh. Mục đích của em là hướng dẫn chủ topic về method FillDown và AutoFill của Range, suốt ngày copy vào mảng rồi cộng trừ chán lắm.
Bài đã được tự động gộp:

Anh oy, anh viết gì vậy?
Các khoảng trống đó người ta đều có dữ liệu hết mớ
Anh insert như vậy để mất hết dữ liệu àh.
anh xem và làm lại đi anh nhé!
Hi hi hi....
Ý bạn nói là cột A có dữ liệu à? Nếu vậy thì insert 1 cột làm cột phụ rồi xóa. Đầu tiên gọi là bác cháu, rồi bạn, rồi anh. Chắc tý nữa xuống thằng. Hic.
 
Lần chỉnh sửa cuối:
Em chỉ định đố vui thôi chứ có dạy gì đâu. Nhưng code cũng không phải vô dụng, trong trường hợp tổng quát nếu có nhiều dòng thì copy từng dòng sẽ làm chương trình chạy chậm. Tất nhiên do đố vui nên em làm thế, còn thường cột phụ sẽ dùng vòng lặp để gán vào mảng rồi copy vào sheet sẽ nhanh. Mục đích của em là hướng dẫn chủ topic về method FillDown và AutoFill của Range, suốt ngày copy vào mảng rồi cộng trừ chán lắm.
Bài đã được tự động gộp:

Ý bạn nói là cột A có dữ liệu à? Nếu vậy thì insert 1 cột làm cột phụ rồi xóa. Đầu tiên gọi là bác cháu, rồi bạn, rồi anh. Chắc tý nữa xuống thằng. Hic.
hi hi hui... Cái anh này thì,,,,
em phải xem thì em mới xưng hô chứ
Thế anh dạy em cách của anh nhé
Em rất cảm ơn.
Nhưng sao bài trước anh bảo không cần vòng lặp cơ mà?
 
hi hi hui... Cái anh này thì,,,,
em phải xem thì em mới xưng hô chứ
Thế anh dạy em cách của anh nhé
Em rất cảm ơn.
Nhưng sao bài trước anh bảo không cần vòng lặp cơ mà?
code này có vòng lặp nào đâu? Hiểu được những method và property của range cũng là cần thiết mà.
Mã:
Sub abc()
    Dim arr(), r As Range, m&, n&, GianCach&
    arr = Range("B2").CurrentRegion
    GianCach = InputBox("So dong can insert?")
    n = UBound(arr)
    m = UBound(arr, 2)
    Set r = Range("B2").Offset(n + 10)
    r.Value = 1
    r.AutoFill r.Resize(n, 1), xlFillSeries
    r.Offset(, 1).Resize(n, m) = arr
    r.Offset(, -1).Formula = "=1+MOD(ROW(A1)-1," & n & ")"
    Set r = r.Offset(, -1).Resize(n * GianCach, 1)
    r.FillDown
    r.Copy
    r.PasteSpecial xlPasteValues
    r.Resize(, m + 2).Sort key1:=r, Header:=xlNo
    r.Clear
End Sub
 
code này có vòng lặp nào đâu? Hiểu được những method và property của range cũng là cần thiết mà.
Mã:
Sub abc()
    Dim arr(), r As Range, m&, n&, GianCach&
    arr = Range("B2").CurrentRegion
    GianCach = InputBox("So dong can insert?")
    n = UBound(arr)
    m = UBound(arr, 2)
    Set r = Range("B2").Offset(n + 10)
    r.Value = 1
    r.AutoFill r.Resize(n, 1), xlFillSeries
    r.Offset(, 1).Resize(n, m) = arr
    r.Offset(, -1).Formula = "=1+MOD(ROW(A1)-1," & n & ")"
    Set r = r.Offset(, -1).Resize(n * GianCach, 1)
    r.FillDown
    r.Copy
    r.PasteSpecial xlPasteValues
    r.Resize(, m + 2).Sort key1:=r, Header:=xlNo
    r.Clear
End Sub
Nhưng anh ui, Mất hết dữ liệu của em roài
Bắt đền anh đó.
 
Nếu dữ liệu lớn thì gán dữ liệu vào mảng rồi gán xuống sheet 1 lần sẽ nhanh hơn nhiều. Tuy nhiên vì là gán dữ liệu nên các định dạng sẽ không đi theo như copy.
 
Anh oy, anh viết gì vậy?
Các khoảng trống đó người ta đều có dữ liệu hết mớ
Anh insert như vậy để mất hết dữ liệu àh.
anh xem và làm lại đi anh nhé!
Hi hi hi....
Nếu muốn Copy lặp xuống 8 dòng thì chỉ cần sửa code bài 4 đúng 1 chữ.
Nói chung tôi chẳng hiểu muốn Insert 8 dòng trống để làm gì?
 
Nếu muốn Copy lặp xuống 8 dòng thì chỉ cần sửa code bài 4 đúng 1 chữ.
Nói chung tôi chẳng hiểu muốn Insert 8 dòng trống để làm gì?
Bác @be09 ui, thật ra thì bài toán này đã có đáp án của bác
SA_DQ
giải được cho cháu rùi. Nhưng bởi vì cháu đang học nên có nhiều đáp án và nhiều giải pháp thì càng tốt cho cháu, cháu cảm ơn các bác, anh chị đã giúp đỡ. Nếu có nhiều cách giải thì càng tốt bác à.
Bài đã được tự động gộp:

Nếu dữ liệu lớn thì gán dữ liệu vào mảng rồi gán xuống sheet 1 lần sẽ nhanh hơn nhiều. Tuy nhiên vì là gán dữ liệu nên các định dạng sẽ không đi theo như copy.
Anh ơi, anh làm mẫu cho em với, không cần phải định dạng đâu anh à.
Cảm ơn anh trước nhé.
 

File đính kèm

Code như File bài 4, nội dung thì như bài 26 sửa đúng 1 chữ, sẽ Copy từ sheet2 sang sheet1 và Copy xuống 8 dòng.
Bác ui, bác @be09 ui, bác vẫn hiểu sai vấn đề bác à
Cháu muốn copy cách khoảng cách cơ mà bác
Nhưng cũng là 1 cách hay để cháu vận dung
Cảm ơn bác!
 
Nhưng anh ui, Mất hết dữ liệu của em roài
Bắt đền anh đó.
Dữ liệu đã mất thì không thể đào lên được. Mình đền file này, dữ liệu lớn hơn 1 chút. Trong file có sẵn 2 sub để khởi tạo dữ liệu ở 2 sheet. Sau khi chạy 2 sub thì:
- Sheet1 có 100.000 dòng x 50 cột dạng:
a1, a1, a1..
a2, a2, a2...
a3, a3, a3...
.................
- Sheet2 có 500.000 dòng x 50 cột:
các dòng 1, 6, 11, 16, ... trống
các dòng 2, 3, 4, 5 chứa số 1
các dòng 7, 8, 9, 10 chứa số 2
các dòng 12, 13, 14, 15 chứa số 3...
Bạn thử viết code copy các dòng ở sheet1 vào sheet2 sao cho dòng ai, ai,... nằm trên 4 dòng i, i,... (i từ 1 đến 100.000)
Mã:
Sub KhoiTaoSheet1()
    Dim i&, j&, arr(1 To 100000, 1 To 50)
    Application.ScreenUpdating = False
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            arr(i, j) = "a" & i
        Next
    Next
    Sheet1.Cells.Clear
    Sheet1.Range("A1").Resize(UBound(arr), UBound(arr, 2)) = arr
    Application.ScreenUpdating = True
End Sub
Sub KhoiTaoSheet2()
    Dim i&, j&, k&, n&, arr()
    Application.ScreenUpdating = False
    ReDim arr(1 To 500000, 1 To 50)
    For i = 1 To 500000
        n = (i - 1) \ 5 + 1
        k = k + 1
        If k = 6 Then k = 1
        For j = 1 To 50
            If k > 1 Then arr(i, j) = n
        Next
    Next
    Sheet2.Cells.Clear
    Sheet2.Range("A1").Resize(UBound(arr), UBound(arr, 2)) = arr
    Application.ScreenUpdating = True
End Sub
 

File đính kèm

Dữ liệu đã mất thì không thể đào lên được. Mình đền file này, dữ liệu lớn hơn 1 chút. Trong file có sẵn 2 sub để khởi tạo dữ liệu ở 2 sheet. Sau khi chạy 2 sub thì:
- Sheet1 có 100.000 dòng x 50 cột dạng:
a1, a1, a1..
a2, a2, a2...
a3, a3, a3...
.................
- Sheet2 có 500.000 dòng x 50 cột:
các dòng 1, 6, 11, 16, ... trống
các dòng 2, 3, 4, 5 chứa số 1
các dòng 7, 8, 9, 10 chứa số 2
các dòng 12, 13, 14, 15 chứa số 3...
Bạn thử viết code copy các dòng ở sheet1 vào sheet2 sao cho dòng ai, ai,... nằm trên 4 dòng i, i,... (i từ 1 đến 100.000)
Mã:
Sub KhoiTaoSheet1()
    Dim i&, j&, arr(1 To 100000, 1 To 50)
    Application.ScreenUpdating = False
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            arr(i, j) = "a" & i
        Next
    Next
    Sheet1.Cells.Clear
    Sheet1.Range("A1").Resize(UBound(arr), UBound(arr, 2)) = arr
    Application.ScreenUpdating = True
End Sub
Sub KhoiTaoSheet2()
    Dim i&, j&, k&, n&, arr()
    Application.ScreenUpdating = False
    ReDim arr(1 To 500000, 1 To 50)
    For i = 1 To 500000
        n = (i - 1) \ 5 + 1
        k = k + 1
        If k = 6 Then k = 1
        For j = 1 To 50
            If k > 1 Then arr(i, j) = n
        Next
    Next
    Sheet2.Cells.Clear
    Sheet2.Range("A1").Resize(UBound(arr), UBound(arr, 2)) = arr
    Application.ScreenUpdating = True
End Sub
Cái anh này, trêu em để hỏng máy của em hả?
Hu hu hu,,
 

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

Back
Top Bottom