TĂNG TỐC CODE THÊM DÒNG CÓ ĐIỀU KIỆN

vubinh099

Thành viên mới
Tham gia ngày
30 Tháng mười 2015
Bài viết
33
Được thích
1
Điểm
165
Hi các bác,
Em có code insert dòng sau đây, dữ liệu ít thì ok, nhưng số dòng insert tăng lên vài trăm là chậm rõ rệt. Các bác có giải pháp nào giúp em không ạ. Em cám ơn!
Mã:
Sub themdong()
Dim i As Long, lr As Long
lr = Sheet1.Cells(Rows.Count, "C").End(3).Row
For i = 2 To lr
    If Range("C" & i).Value <> Range("C" & i - 1) Then
        Range("C" & i).EntireRow.Insert
        i = i + 1
        Range("C" & i - 1).Value = Range("C" & i)
        Range("D" & i - 1).Value = Range("D" & i)
    End If
Next i
End Sub
 

File đính kèm

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
5,888
Được thích
9,820
Điểm
860
Bạn khai báo 2 mảng
1 mảng chứa nguồn; mảng sau chứa dữ liệu đích

(File của bạn không cho fép thực hiện í tưởng, nên chỉ gợi ý với bạn vậy thôi) & chúc tuần làm việc hiệu quả!
 

VetMini

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
6,807
Được thích
7,958
Điểm
560
Insert và delete thì làm ngược từ dưới lên. Làm từ trên xuống sẽ bị lặp lại nhiều lần.
Tôi chỉ mách đến đó thôi. Bản tính tôi không tiếp xúc với người nói tiếng Việt nhưng chào hỏi bằng tiếng ngoại.
 

CHAOQUAY

Thành viên tiêu biểu
Tham gia ngày
24 Tháng tám 2018
Bài viết
565
Được thích
483
Điểm
235
Hi các bác,
Em có code insert dòng sau đây, dữ liệu ít thì ok, nhưng số dòng insert tăng lên vài trăm là chậm rõ rệt. Các bác có giải pháp nào giúp em không ạ. Em cám ơn!
Mã:
Sub themdong()
Dim i As Long, lr As Long
lr = Sheet1.Cells(Rows.Count, "C").End(3).Row
For i = 2 To lr
    If Range("C" & i).Value <> Range("C" & i - 1) Then
        Range("C" & i).EntireRow.Insert
        i = i + 1
        Range("C" & i - 1).Value = Range("C" & i)
        Range("D" & i - 1).Value = Range("D" & i)
    End If
Next i
End Sub
Nếu số liệu không có công thức thì có thể tạo mảng mới theo điều kiện insert, sau đó gán xuống sheet sẽ nhanh hơn
 

vubinh099

Thành viên mới
Tham gia ngày
30 Tháng mười 2015
Bài viết
33
Được thích
1
Điểm
165
Bạn khai báo 2 mảng
1 mảng chứa nguồn; mảng sau chứa dữ liệu đích

(File của bạn không cho fép thực hiện í tưởng, nên chỉ gợi ý với bạn vậy thôi) & chúc tuần làm việc hiệu quả!
Cám ơn bạn. Mình đã nghiên cứu và... không biết làm :(. Bạn giúp mình nốt nhé!
Bài đã được tự động gộp:

Insert và delete thì làm ngược từ dưới lên. Làm từ trên xuống sẽ bị lặp lại nhiều lần.
Tôi chỉ mách đến đó thôi. Bản tính tôi không tiếp xúc với người nói tiếng Việt nhưng chào hỏi bằng tiếng ngoại.
Cám ơn bạn, mình sẽ rút kinh nghiệm!
Bài đã được tự động gộp:

Nếu số liệu không có công thức thì có thể tạo mảng mới theo điều kiện insert, sau đó gán xuống sheet sẽ nhanh hơn
Cám ơn bạn. Mình chưa biết cách làm theo kiểu đưa số liệu vào 1 mảng, xong xử lý, xong đưa ra excel. Bạn giúp mình nhé.
 

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,724
Được thích
3,933
Điểm
860
Cám ơn bạn. Mình đã nghiên cứu và... không biết làm :(. Bạn giúp mình nốt nhé!
Bài đã được tự động gộp:


Cám ơn bạn, mình sẽ rút kinh nghiệm!
Bài đã được tự động gộp:


Cám ơn bạn. Mình chưa biết cách làm theo kiểu đưa số liệu vào 1 mảng, xong xử lý, xong đưa ra excel. Bạn giúp mình nhé.
Bạn up file thực tế của bạn lên sẽ được giúp ngay. Vì bạn không biết cách đưa vào mảng anh em giúp xong lại không biết áp dụng vào file thực tế nửa thì tiếp tục sửa nửa....
 

vubinh099

Thành viên mới
Tham gia ngày
30 Tháng mười 2015
Bài viết
33
Được thích
1
Điểm
165

File đính kèm

VetMini

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
6,807
Được thích
7,958
Điểm
560
Theo code thì là Sheet1, duyệt cột C, cứ mỗi trị mới thì chèn thêm một dòng, copy trị ở C và D vào dòng mới.
Chỗ còn lại (cột A, B) và E trở đi chắc để trống.
Đây có lẽ là một cách chèn dòng tổng.
 

vubinh099

Thành viên mới
Tham gia ngày
30 Tháng mười 2015
Bài viết
33
Được thích
1
Điểm
165
Bạn này nực cười quá, bạn up file lên thế anh em cần giúp file nào? xử lý trên sheet nào? Cột cần xử lý là cột nào? dựa vào điều kiện cột nào? Khi nào mới chạy code?...
Xin lỗi bạn nhé. Mình không nói rõ.
File ChuongTrinh, Sheets "TMP", Module "Main" và tại dòng code thêm dòng(hiện tại chưa thay đổi) mà mình có note là 'Them dong
Bài đã được tự động gộp:

Theo code thì là Sheet1, duyệt cột C, cứ mỗi trị mới thì chèn thêm một dòng, copy trị ở C và D vào dòng mới.
Chỗ còn lại (cột A, B) và E trở đi chắc để trống.
Đây có lẽ là một cách chèn dòng tổng.
Vâng, đúng là thêm dòng tổng ạ!
 

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,724
Được thích
3,933
Điểm
860
Xin lỗi bạn nhé. Mình không nói rõ.
File ChuongTrinh, Sheets "TMP", Module "Main" và tại dòng code thêm dòng(hiện tại chưa thay đổi) mà mình có note là 'Them dong
Bài đã được tự động gộp:


Vâng, đúng là thêm dòng tổng ạ!
Do dữ liệu bạn nhiều thế kia lại nhiều định dạng nên thêm dòng mới bằng cách gán vào mảng sau đó đưa vào sheet thì các định dạng sẽ chạy trật lất hết nhé, nếu cần tôi sẽ giúp như phần định dạng thì bạn tự sửa được không? Chứ nhìn một đám rừng kia ớn quá.
 

vubinh099

Thành viên mới
Tham gia ngày
30 Tháng mười 2015
Bài viết
33
Được thích
1
Điểm
165
Do dữ liệu bạn nhiều thế kia lại nhiều định dạng nên thêm dòng mới bằng cách gán vào mảng sau đó đưa vào sheet thì các định dạng sẽ chạy trật lất hết nhé, nếu cần tôi sẽ giúp như phần định dạng thì bạn tự sửa được không? Chứ nhìn một đám rừng kia ớn quá.
Mình có thể làm được. Bạn giúp mình nhé.
Cám ơn bạn!
 

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,724
Được thích
3,933
Điểm
860
Mình có thể làm được. Bạn giúp mình nhé.
Cám ơn bạn!
Thay đoạn code Them dong của bạn thành đoạn này xem sao.
Mã:
Dim Arr(), dArr()
dArr = Range("A4:Q" & Range("E1000000").End(xlUp).Row).Value
ReDim Arr(1 To (UBound(dArr) + Application.WorksheetFunction.CountA(Range("C4:C1000000")) * 2), 1 To 17)
k = 1
For i = 1 To UBound(dArr) - 1
    k = k + 1
    For j = 1 To 17
        Arr(k, j) = dArr(i, j)
    Next j
    If dArr(i, 3) <> dArr(i + 1, 3) And i <> 1 Then
        i = i + 1:
        k = k + 2
        For j = 1 To 17
            Arr(k, j) = dArr(i, j)
        Next j
        i = i + 1
    End If
    
Next i
Range("A4.Q4").Resize(k) = Arr
 

vubinh099

Thành viên mới
Tham gia ngày
30 Tháng mười 2015
Bài viết
33
Được thích
1
Điểm
165
Thay đoạn code Them dong của bạn thành đoạn này xem sao.
Mã:
Dim Arr(), dArr()
dArr = Range("A4:Q" & Range("E1000000").End(xlUp).Row).Value
ReDim Arr(1 To (UBound(dArr) + Application.WorksheetFunction.CountA(Range("C4:C1000000")) * 2), 1 To 17)
k = 1
For i = 1 To UBound(dArr) - 1
    k = k + 1
    For j = 1 To 17
        Arr(k, j) = dArr(i, j)
    Next j
    If dArr(i, 3) <> dArr(i + 1, 3) And i <> 1 Then
        i = i + 1:
        k = k + 2
        For j = 1 To 17
            Arr(k, j) = dArr(i, j)
        Next j
        i = i + 1
    End If
   
Next i
Range("A4.Q4").Resize(k) = Arr
Cám ơn bạn rất nhiều!
Đoạn code trên nhanh hơn đoạn code cũ phải đến 10 lần.

Nhưng mà làm sao để đưa đoạn code sau tích hợp vào code trên luôn, rồi mới đưa Arr vào sheet?
Code này để thêm giá trị vào dòng vừa insert.
Mã:
lr1 = Sheet9.Cells(Rows.Count, "C").End(3).Row
For i = 4 To lr1
If Cells(i, 3) = vbEmpty Then
    Cells(i, 3) = Cells(i + 1, 3)
    Cells(i, 4) = Cells(i + 1, 4)
End If
Next i
 

File đính kèm

vubinh099

Thành viên mới
Tham gia ngày
30 Tháng mười 2015
Bài viết
33
Được thích
1
Điểm
165
Thay đoạn code Them dong của bạn thành đoạn này xem sao.
Mã:
Dim Arr(), dArr()
dArr = Range("A4:Q" & Range("E1000000").End(xlUp).Row).Value
ReDim Arr(1 To (UBound(dArr) + Application.WorksheetFunction.CountA(Range("C4:C1000000")) * 2), 1 To 17)
k = 1
For i = 1 To UBound(dArr) - 1
    k = k + 1
    For j = 1 To 17
        Arr(k, j) = dArr(i, j)
    Next j
    If dArr(i, 3) <> dArr(i + 1, 3) And i <> 1 Then
        i = i + 1:
        k = k + 2
        For j = 1 To 17
            Arr(k, j) = dArr(i, j)
        Next j
        i = i + 1
    End If
   
Next i
Range("A4.Q4").Resize(k) = Arr
Bạn ơi, code của bạn chưa đúng. Kết quả ra thiếu giá trị, mất dòng.
 

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,724
Được thích
3,933
Điểm
860
Bạn ơi, code của bạn chưa đúng. Kết quả ra thiếu giá trị, mất dòng.
Trước hết xin khẳng định lại thế này, code trong file ở bài 1 đúng chưa? Nếu chưa đúng thì đúng phải là như thế nào? còn nếu đã đúng thì bạn chỉ cần khắc phục tốc độ thôi phải không?
 

vubinh099

Thành viên mới
Tham gia ngày
30 Tháng mười 2015
Bài viết
33
Được thích
1
Điểm
165
Trước hết xin khẳng định lại thế này, code trong file ở bài 1 đúng chưa? Nếu chưa đúng thì đúng phải là như thế nào? còn nếu đã đúng thì bạn chỉ cần khắc phục tốc độ thôi phải không?
Tốc độ thì tuyệt vời rồi, nhưng lúc đầu có 940 giá trị ở cột C4:C1000, sau khi thêm dòng chỉ còn 932 giá trị. Bạn xem lại giúp mình với! :(
Cám ơn bạn!
 

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,724
Được thích
3,933
Điểm
860
Tốc độ thì tuyệt vời rồi, nhưng lúc đầu có 940 giá trị ở cột C4:C1000, sau khi thêm dòng chỉ còn 932 giá trị. Bạn xem lại giúp mình với! :(
Cám ơn bạn!
Sửa lại thế này xem.
Mã:
Dim Arr(), dArr()
dArr = Range("A4:Q" & Range("E1000000").End(xlUp).Row).Value
ReDim Arr(1 To (UBound(dArr) * 2), 1 To 17)
k = 1
For i = 1 To UBound(dArr) - 1
    k = k + 1
    For j = 1 To 17
        Arr(k, j) = dArr(i, j)
    Next j
    If dArr(i, 3) <> dArr(i + 1, 3) And i <> 1 Then
        k = k + 2
        For j = 1 To 17
            Arr(k, j) = dArr(i + 1, j)
        Next j
        i = i + 1
    End If
    
Next i
Range("A4.Q4").Resize(k) = Arr
 

vubinh099

Thành viên mới
Tham gia ngày
30 Tháng mười 2015
Bài viết
33
Được thích
1
Điểm
165
Sửa lại thế này xem.
Mã:
Dim Arr(), dArr()
dArr = Range("A4:Q" & Range("E1000000").End(xlUp).Row).Value
ReDim Arr(1 To (UBound(dArr) * 2), 1 To 17)
k = 1
For i = 1 To UBound(dArr) - 1
    k = k + 1
    For j = 1 To 17
        Arr(k, j) = dArr(i, j)
    Next j
    If dArr(i, 3) <> dArr(i + 1, 3) And i <> 1 Then
        k = k + 2
        For j = 1 To 17
            Arr(k, j) = dArr(i + 1, j)
        Next j
        i = i + 1
    End If
    
Next i
Range("A4.Q4").Resize(k) = Arr
Cám ơn bạn nhiều nhé!
Mình chưa test thử nhưng mình nghĩ chắc là ok rồi, vì bây giờ mình mới hiểu cái code nói gì.
Cám ơn nhiều ạ. Chúc 1 ngày tốt lành!
 
Top Bottom