Chèn dòng theo điều kiện

[AnhThu-1976]

Anh/chị giúp em cách chèn dòng theo điều kiện như sau:
Tại sheet 1, cột B sẽ có những mã AAA, BBB, CCC, ... (và những mã này có thể lập lại)
Bây giờ em muốn chèn thêm dòng dưới những mã AAA thì làm như thế nào cho nhanh
Kết quả em muốn như ở sheet "KetQua"
Em cảm ơn!

 

[Ba Tê]

Anh/chị giúp em cách chèn dòng theo điều kiện như sau:
Tại sheet 1, cột B sẽ có những mã AAA, BBB, CCC, ... (và những mã này có thể lập lại)
Bây giờ em muốn chèn thêm dòng dưới những mã AAA thì làm như thế nào cho nhanh
Kết quả em muốn như ở sheet "KetQua"
Em cảm ơn!

Chạy thử Sub này xem sao:

Public Sub sGpe()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Txt As String
sArr = Sheet1.Range("A2", Sheet1.Range("B2").End(xlDown)).Resize(, 4).Value
R = UBound(sArr)
ReDim dArr(1 To R * 2, 1 To 4)
Txt = "AAA"
For I = 1 To R
    K = K + 1
    For J = 1 To 4
        dArr(K, J) = sArr(I, J)
    Next J
    If sArr(I, 2) = Txt Then K = K + 1
Next I
Sheet2.Range("A2").Resize(K, 4) = dArr
End Sub

 

[huuthang_bd]

Anh/chị giúp em cách chèn dòng theo điều kiện như sau:
Tại sheet 1, cột B sẽ có những mã AAA, BBB, CCC, ... (và những mã này có thể lập lại)
Bây giờ em muốn chèn thêm dòng dưới những mã AAA thì làm như thế nào cho nhanh
Kết quả em muốn như ở sheet "KetQua"
Em cảm ơn!

Có AAA liên tiếp không? Nếu có thì chèn sao?

 

[AnhThu-1976]

Có AAA liên tiếp không? Nếu có thì chèn sao?

Không có AAA liên tiếp

 

[huuthang_bd]

Không có AAA liên tiếp

F3=1/(B2<>"AAA")

Chọn F3:F10
Nhấn Ctrl + D
Nhấn Ctrl + G -> Special... -> Chọn Formula + Errors -> OK
Nhấn Ctrl + + -> Chọn Entire Row -> OK

 

[snow25]

Chạy thử Sub này xem sao:

Public Sub sGpe()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long, Txt As String
sArr = Sheet1.Range("A2", Sheet1.Range("B2").End(xlDown)).Resize(, 4).Value
R = UBound(sArr)
ReDim dArr(1 To R * 2, 1 To 4)
Txt = "AAA"
For I = 1 To R
    K = K + 1
    For J = 1 To 4
        dArr(K, J) = sArr(I, J)
    Next J
    If sArr(I, 2) = Txt Then K = K + 1
Next I
Sheet2.Range("A2").Resize(K, 4) = dArr
End Sub

bác
Ba Tê bạn đấy muốn insert thêm dòng chứ không phải là chuyển sang bảng tính mới.chắc là bạn đó muốn thêm dữ liệu vào sau ký tự "AAA"

 

[snow25]

Anh/chị giúp em cách chèn dòng theo điều kiện như sau:
Tại sheet 1, cột B sẽ có những mã AAA, BBB, CCC, ... (và những mã này có thể lập lại)
Bây giờ em muốn chèn thêm dòng dưới những mã AAA thì làm như thế nào cho nhanh
Kết quả em muốn như ở sheet "KetQua"
Em cảm ơn!

bạn chạy thử code này xem nhé

Dim sArr(), dArr(), I As Long, a As Long, K As Long, R As Long, Txt As String
sArr = Sheet1.Range("A2:b" & Sheet1.Range("B" & Rows.Count).End(xlUp).Row).Value
R = UBound(sArr)
Txt = "AAA"
For I = 2 To R - 1
       If UCase(sArr(I, 2)) = UCase(Txt) Then
          If UCase(sArr(I + 1, 2)) <> Empty Then
             Rows(I + 2 + a & ":" & I + 2 + a).Insert
              a = a + 1
          End If
       End If
Next I
End Sub

 

[Phuocam]

Public Sub test()
Dim lr As Long, i As Long
lr = Range("B" & Rows.Count).End(xlUp).Row
For i = lr To 3 Step -1
    If Cells(i, 2) <> "" And Cells(i - 1, 2) = "AAA" Then Rows(i).Insert
Next
End Sub