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

Liên hệ QC

vubinh099

Thành viên mới
Tham gia
30/10/15
Bài viết
43
Được thích
4
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

  • them dong.xls
    260 KB · Đọc: 15
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ả!
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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é.
 
Upvote 0
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....
 
Upvote 0
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.
 
Upvote 0
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 ạ!
 
Upvote 0
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á.
 
Upvote 0
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!
 
Upvote 0
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
 
Upvote 0
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

  • themdong1.rar
    141.8 KB · Đọc: 3
Upvote 0
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.
 
Upvote 0
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?
 
Upvote 0
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!
 
Upvote 0
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
 
Upvote 0
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!
 
Upvote 0
Web KT
Back
Top Bottom