Copy dòng cách quãng

Hau151978 · 30/7/18

SA_DQ đã viết:
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: 30/7/18

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

hongphuong1997 · 30/7/18

Hau151978 đã viết:
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: 30/7/18

Ý 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à?

Hau151978 · 30/7/18

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

hongphuong1997 · 30/7/18

Hau151978 đã viết:

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 đó.

huuthang_bd · 31/7/18

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.

be_09 · 31/7/18

hongphuong1997 đã viết:
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ì?

hongphuong1997 · 31/7/18

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

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

huuthang_bd · 31/7/18

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

Giờ nghỉ trưa rồi. Chiều sẽ viết 2 code cho bạn so sánh.

hongphuong1997 · 31/7/18

huuthang_bd đã viết:
Giờ nghỉ trưa rồi. Chiều sẽ viết 2 code cho bạn so sánh.

Vâng ạ, cảm ơn anh nhé!

be_09 · 31/7/18

hongphuong1997 đã viết:
Bác @be09
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.

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.

hongphuong1997 · 31/7/18

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

huuthang_bd · 31/7/18

hongphuong1997 đã viết:
Vâng ạ, cảm ơn anh nhé!

Như đã hứa.

hongphuong1997 · 31/7/18

huuthang_bd đã viết:
Như đã hứa.

Hi hi anh oy, em cảm ơn anh nhé!
thật sự nó là vô vàn đáp án anh nhỉ.

huuthang_bd · 31/7/18

hongphuong1997 đã viết:
Hi hi anh oy, em cảm ơn anh nhé!
thật sự nó là vô vàn đáp án anh nhỉ.

Không được dùng ngôn ngữ "teen" nha bạn.

Hau151978 · 31/7/18

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

hongphuong1997 · 31/7/18

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

Hau151978 · 31/7/18

hongphuong1997 đã viết:
Cái anh này, trêu em để hỏng máy của em hả?
Hu hu hu,,

Mình đã chạy thử code tạo ra file khoảng 70MB, nén lại còn khoảng 1MB. Code chạy bình thường, hết khoảng 2 - 3 phút. Mình test code khởi tạo sheet và copy trên máy core i5, ram 4GB.

Copy dòng cách quãng

Thành viên tích cực

Thành viên tiêu biểu

Thành viên tích cực

Thành viên tiêu biểu

Chuyên gia GPE

Biên Hòa, Đồng Nai

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tiêu biểu

Biên Hòa, Đồng Nai

File đính kèm

Thành viên tiêu biểu

Chuyên gia GPE

File đính kèm

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tích cực

File đính kèm

Thành viên tiêu biểu

Thành viên tích cực

Đếm ngược thời gian