Insert thêm hoặc xóa bớt dòng theo range có sẵn

[kobebryant]

Mình có 1 vùng dữ liệu ở sheet data, ở Sheet BC1 mình muốn tạo vùng dữ liệu bằng số lượng dòng với số lượng dòng ở sheet data, sheet BC1 có thể đang có sẵn nhiều dòng hơn hoặc ít dòng hơn.
Mình có viết code này nhưng khi dữ liệu lên 4000-5000 dòng là chạy chắc phải 10p. Không biết anh em có code nào để chạy nhanh hơn được ko
Cụ thể là mình xem 2 cell được đặt tên "CuoiData" và "CuoiBC1" xem CuoiBC1.Row nhiều hơn hay ít hơn CuoiData (có + thêm mấy dòng lệch nhau vì tiêu đề) thì xóa đi từng dòng hoặc insert từng dòng nên rất chậm
Mình có gửi file minh họa đính kèm.

    Dim a As Integer
    Dim b As Integer
    Dim c As Integer
    Dim X As Integer
    If Sheets("SCT").Range("CuoiSCT").Row > Sheets("NKC").Range("CuoiNKC").Row Then
        b = Sheets("BC1").Range("CuoiBC1").Row - Sheets("data").Range("CuoiData").Row - 2
        For a = 1 To b
        X = Sheets("BC1").Range("CuoiBC1").Row - 1
        Rows(X).EntireRow.Delete xlUp
        Next a
    ElseIf Sheets("BC1").Range("CuoiBC1").Row <= Sheets("data").Range("CuoiData").Row Then
        c = Sheets("data").Range("CuoiData").Row - Sheets("BC1").Range("CuoiBC1").Row + 2
    For a = 1 To c
        Sheets("BC1").Range("CuoiBC1").EntireRow.Insert
    Next a
    End If

 

[SA_DQ]

(1) Bạn tham khảo macro này xem có xíu nào hữu ích với bạn không?
Trước khi cho macro vận hành, ta đến ô có chuỗi 'Người lập' ở trang 'Data' & tiến hành gán cho nó cái tên "NgLap"

Sub TimDongCuoi()
 Dim Rng As Range, sRng As Range
 
 With Sheets("BC1")
    Set Rng = .[A1].Resize(99)
    Set sRng = Rng.Find(Sheets("Data").Range("NgLap").Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MsgBox sRng.Row
    End If
 End With
End Sub

(2) Nếu là mình thì mình cho dư tối đa số dòng ở trang 'BCao',
Sau đó xác định chỉ số dòng cuối chứa dữ liệu bên 'Data', thừa bao nhiêu dòng bên 'BCao' ta cho ẩn đi.

 

[kobebryant]

(1) Bạn tham khảo macro này xem có xíu nào hữu ích với bạn không?
Trước khi cho macro vận hành, ta đến ô có chuỗi 'Người lập' ở trang 'Data' & tiến hành gán cho nó cái tên "NgLap"

Sub TimDongCuoi()
 Dim Rng As Range, sRng As Range
 
 With Sheets("BC1")
    Set Rng = .[A1].Resize(99)
    Set sRng = Rng.Find(Sheets("Data").Range("NgLap").Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MsgBox sRng.Row
    End If
 End With
End Sub

(2) Nếu là mình thì mình cho dư tối đa số dòng ở trang 'BCao',
Sau đó xác định chỉ số dòng cuối chứa dữ liệu bên 'Data', thừa bao nhiêu dòng bên 'BCao' ta cho ẩn đi.

em thấy code này chỉ xác định được dòng bên BC1. Còn số dòng BC1 nếu đang nhiều hơn data thì xóa bớt đi cho bằng số dòng bên data (ví dụng đang có 18 dòng), ít dòng hơn thì insert thêm từ dưới lên cho bằng thì chưa có. Như code cũ em tự viết nó delete từng dòng hoặc insert từng dòng lên 4000 dòng là chạy 10p chưa xong.
do nội dung bên BC1 có công thức excel update theo sheet data nên để thừa rất chậm ạ

 

[Maika8008]

em thấy code này chỉ xác định được dòng bên BC1. Còn số dòng BC1 nếu đang nhiều hơn data thì xóa bớt đi cho bằng số dòng bên data (ví dụng đang có 18 dòng), ít dòng hơn thì insert thêm từ dưới lên cho bằng thì chưa có. Như code cũ em tự viết nó delete từng dòng hoặc insert từng dòng lên 4000 dòng là chạy 10p chưa xong.
do nội dung bên BC1 có công thức excel update theo sheet data nên để thừa rất chậm ạ

Code mà tác động lên cấu trúc của sheet liên tục tất nhiên là chạy chậm rồi. Cách nhanh là xác định xong vùng cần xóa rồi xóa 1 lần.

 

[SA_DQ]

em thấy code này chỉ xác định được dòng bên BC1. Còn số dòng BC1 nếu đang nhiều hơn data thì xóa bớt đi cho bằng số dòng bên data (ví dụ. . . . . .

Khi chạy macro xong sẽ có 3 trường hợp :
1: Dòng tìm thấy = dòng 18: => OK
2./ Dòng tìm thấy lớn hơn dòng 18 Ta ban hành lệnh Rows("18:"& [DongTimThay]).Xóa
3./ Dòng tìm thấy bé hơn dòng 18; ta ban hành lệnh Rows([DongTimThay] & ":18").Xóa

 

[kobebryant]

Khi chạy macro xong sẽ có 3 trường hợp :
1: Dòng tìm thấy = dòng 18: => OK
2./ Dòng tìm thấy lớn hơn dòng 18 Ta ban hành lệnh Rows("18:"& [DongTimThay]).Xóa
3./ Dòng tìm thấy bé hơn dòng 18; ta ban hành lệnh Rows([DongTimThay] & ":18").Xóa

dạ cho em xin giải pháp luôn với ạ, chứ trong đầu em giờ chỉ hiểu theo lối mòn em tự nghĩ ra thôi ạ

 

[Nhattanktnn]

dạ cho em xin giải pháp luôn với ạ, chứ trong đầu em giờ chỉ hiểu theo lối mòn em tự nghĩ ra thôi ạ

Hãy đưa dữ liệu thật đang làm lên, có thể chế số liệu nếu cần bảo mật. Vì có thể có cách làm khác thay vì xóa và chèn dòng

 

[SA_DQ]

Bước chuẩn bị:
Bạn thêm dòng để sao cho ô có tên 'CuoiBC1' được đẩy xuống dòng thứ 99;

B2: Sau đó chạy macro này:

Sub AnCacDongKhongDuLieu()
 Dim DongBC As Long, DongDL As Long
 
 DongBC = Sheets("BC1").Range("CuoiBC1").Row
 Sheets("BC1").Rows("3:" & DongBC).Hidden = False
 DongDL = Sheets("Data").Range("CuoiData").Row + 2
 Sheets("BC1").Rows(DongDL & ":" & DongBC).Hidden = True
End Sub

 

[kobebryant]

Bước chuẩn bị:
Bạn thêm dòng để sao cho ô có tên 'CuoiBC1' được đẩy xuống dòng thứ 99;

B2: Sau đó chạy macro này:

Sub AnCacDongKhongDuLieu()
 Dim DongBC As Long, DongDL As Long
 
 DongBC = Sheets("BC1").Range("CuoiBC1").Row
 Sheets("BC1").Rows("3:" & DongBC).Hidden = False
 DongDL = Sheets("Data").Range("CuoiData").Row + 2
 Sheets("BC1").Rows(DongDL & ":" & DongBC).Hidden = True
End Sub

tình huống này là ẩn đi, nhưng nếu cần xóa đi thì làm sao anh vì bên BC1 link công thức qua data. Em có gửi lại file đính kèm.
Ngoài ra trường hợp bên BC1 đang có ít dòng hơn data thì làm sao chèn thêm cho đủ số dòng ạ.

 

[VetMini]

Thay cái này:
b = Sheets("BC1").Range("CuoiBC1").Row - Sheets("data").Range("CuoiData").Row - 2
For a = 1 To b
X = Sheets("BC1").Range("CuoiBC1").Row - 1
Rows(X).EntireRow.Delete xlUp
Next a

Bằng cái này:
X1 = Sheets("BC1").Range("CuoiBC1").Row - Sheets("data").Range("CuoiData").Row - 2
X2 = Sheets("BC1").Range("CuoiBC1").Row - 1
Rows((X2-X1+1) &n ":" & X2).EntireRow.Delete xlUp

Và thay cái này:
c = Sheets("data").Range("CuoiData").Row - Sheets("BC1").Range("CuoiBC1").Row + 2
For a = 1 To c
Sheets("BC1").Range("CuoiBC1").EntireRow.Insert
Next a

Bằng:
X1 = Sheets("BC1").Range("CuoiBC1").Row
X2 = Sheets("data").Range("CuoiData").Row - X1+ 2
Sheets("BC1").Rows(X1 & ":" & (X1+X2-1)).EntireRow.Insert

 

[SA_DQ]

(2) tình huống này là ẩn đi, nhưng nếu cần xóa đi thì làm sao anh vì bên BC1 link công thức qua data. Em có gửi lại file đính kèm.
(1) Ngoài ra trường hợp bên BC1 đang có ít dòng hơn data thì làm sao chèn thêm cho đủ số dòng ạ.

(1) Nếu con số 99 chưa hả dạ thì bạn tương vô đó con 9999, hay số nào lớn hơn có thể; Con 99 là tùy biến mà;
(2) Xóa 1 cụm dòng thì các bài trên nào đó đã đề cập mà, tự tùy biến luôn đi!
(3) Đầu câu nên viết bông, chắc bạn đang quên,để chứng tỏ mình tôn trọng diễn đàn & cộng đồng./.

 

[kobebryant]

Dạ cám ơn 2 anh, em áp dụng code của anh VetMini chạy quá ổn rồi ạ

 

[Hoàng Tuấn 868]

chạy quá ổn rồi ạ

Ổn thôi chứ quá ổn thì e rằng lại không ổn đấy, hì hì.

 

[kobebryant]

Ổn thôi chứ quá ổn thì e rằng lại không ổn đấy, hì hì.

Dạ em ráp vào chưa thấy lỗi gì, ko biết anh thấy lỗi chỗ nào cho em biết với ạ

 

[Hoàng Tuấn 868]

Dạ em ráp vào chưa thấy lỗi gì, ko biết anh thấy lỗi chỗ nào cho em biết với ạ

Mình nói vui đấy, thường thì thêm chữ quá là thấy lo lo.