Nhờ thêm Code chèn thêm dòng sau khi dò tìm.

Liên hệ QC

longkurabe

Thành viên mới
Tham gia
13/3/20
Bài viết
16
Được thích
0
Mã:
Sub TIM_SP_TRUNG_NHAU() 
    Dim ws As Worksheet
    Dim cell As Range
    Dim myrng As Range
    Dim clr As Long
    Dim lastcell As Range
    Dim i As Long
    Dim lastrow As Long
    Set ws = ThisWorkbook.ActiveSheet

    Set myrng = ws.Range("A8:A" & Range("A" & ws.Rows.Count).End(xlUp).Row)

    With myrng
    Set lastcell = .Cells(.Cells.Count)
    End With

    myrng.Interior.ColorIndex = xlNone
    clr = 3
    For Each cell In myrng
    If Application.WorksheetFunction.CountIf(myrng, cell) > 1 Then
    If myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastcell).Address = cell.Address Then
    cell.Interior.ColorIndex = clr
    clr = clr + 1
    i = i + 1
    Else
    cell.Interior.ColorIndex = myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastcell).Interior.ColorIndex
    End If
    End If
    Next

    MsgBox "Tong so co " & i & " loai SP trung nhau"
End Sub
Hi diễn đàn, mình có chép đoạn Code nay trên mạng về áp dụng cho File mình, giờ các thành viên Code cho mình thêm là sau khi dò tìm giống nhau thì chèn thêm 1 dòng trắng được không. Xin cám ơn
Chen dong.png
 

File đính kèm

  • 1.xlsb
    19.6 KB · Đọc: 13
Mã:
Sub TIM_SP_TRUNG_NHAU()
    Dim ws As Worksheet
    Dim cell As Range
    Dim myrng As Range
    Dim clr As Long
    Dim lastcell As Range
    Dim i As Long
    Dim lastrow As Long
    Set ws = ThisWorkbook.ActiveSheet

    Set myrng = ws.Range("A8:A" & Range("A" & ws.Rows.Count).End(xlUp).Row)

    With myrng
    Set lastcell = .Cells(.Cells.Count)
    End With

    myrng.Interior.ColorIndex = xlNone
    clr = 3
    For Each cell In myrng
    If Application.WorksheetFunction.CountIf(myrng, cell) > 1 Then
    If myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastcell).Address = cell.Address Then
    cell.Interior.ColorIndex = clr
    clr = clr + 1
    i = i + 1
    Else
    cell.Interior.ColorIndex = myrng.Find(what:=cell, lookat:=xlWhole, MatchCase:=False, after:=lastcell).Interior.ColorIndex
    End If
    End If
    Next

    MsgBox "Tong so co " & i & " loai SP trung nhau"
End Sub
Hi diễn đàn, mình có chép đoạn Code nay trên mạng về áp dụng cho File mình, giờ các thành viên Code cho mình thêm là sau khi dò tìm giống nhau thì chèn thêm 1 dòng trắng được không. Xin cám ơn
View attachment 234443
Cái từ " Hi' Trong tiếng của đồng bào dân tộc Tày nó có nghĩa gì gì ấy. Hình như " Kin hi tua ma dăm" là ăn rằm tháng 7 thì phải
 
Lần chỉnh sửa cuối:
Cái từ " Hi' Trong tiếng của đồng bào dân tộc Tày nó có nghĩa gì gì ấy. Hình như " Kin hi tua ma dăm" là ăn rằm tháng 7 thì phải
Chào bạn, mình kém " môn văn" lắm, mình dùng từ Hi thì cách phát ra bình thường thôi, mình không hiểu ý bạn lắm. Có gì bạn nói rõ thêm dùm.
 
Hi diễn đàn, mình có chép đoạn Code nay trên mạng về áp dụng cho File mình, giờ các thành viên Code cho mình thêm là sau khi dò tìm giống nhau thì chèn thêm 1 dòng trắng được không. Xin cám ơn
Insert lên như dòng màu xanh trong hình được không?

A_Insert.GIF
 
Chào bạn, mình kém " môn văn" lắm, mình dùng từ Hi thì cách phát ra bình thường thôi, mình không hiểu ý bạn lắm. Có gì bạn nói rõ thêm dùm.
Không ai nói chuyện văn học ở đây. Khi gặp những người không thuộc nhóm chát của mình thì bạn chào thế nào? "Cháu chào bác ạ", "Chào em", "Chào các bạn" ... Có lẽ bạn không nói: Hi, đúng không? Và đừng viết tắt như khi đang chát, nhắn tin.
 
Chào bạn, mình kém " môn văn" lắm, mình dùng từ Hi thì cách phát ra bình thường thôi, mình không hiểu ý bạn lắm. Có gì bạn nói rõ thêm dùm.
Ơ ơ đâu có nói chuyện gì đến "môn văn" đâu
PHP:
Sub Chendong()
    Dim sRng As Range, Rng As Range, I As Long
    Set sRng = Range("A8", Range("A" & Rows.Count).End(xlUp))
    For I = 1 To sRng.Rows.Count
        If sRng(I) <> sRng(I).Offset(1) And sRng(I) = sRng(I).Offset(-1) Then
            If Rng Is Nothing Then
                Set Rng = sRng(I).Offset(1)
            Else
                Set Rng = Union(Rng, sRng(I).Offset(1))
            End If
        End If
    Next
    Rng.EntireRow.Insert Shift:=xlDown
End Sub
 
Không ai nói chuyện văn học ở đây. Khi gặp những người không thuộc nhóm chát của mình thì bạn chào thế nào? "Cháu chào bác ạ", "Chào em", "Chào các bạn" ... Có lẽ bạn không nói: Hi, đúng không? Và đừng viết tắt như khi đang chát, nhắn tin.
Bây giờ giới trẻ họ dùng luôn trong nhà rồi bác ạ. Sáng ra chào bố mẹ "Hai". Tối đi ngủ "nái nai". Trong nhà anh chị em trap đổi "du mi" không hà.
Họ hàng đến thăm thì cũng "hê lô" tuốt. Họ hàng sợ bị chê "kém văn minh" nên chỉ biết rủa thầm trong bụng.

Chú: mà nghe từ "hi" mình cứ tưởng đến "thất thập cổ lai hi". Sắp tới rồi. Ngày xưa thì nó cổ lai hi thật. Nhưng bây giờ chắc phải là cửu thập.
 
Ơ ơ đâu có nói chuyện gì đến "môn văn" đâu
PHP:
Sub Chendong()
    Dim sRng As Range, Rng As Range, I As Long
    Set sRng = Range("A8", Range("A" & Rows.Count).End(xlUp))
    For I = 1 To sRng.Rows.Count
        If sRng(I) <> sRng(I).Offset(1) And sRng(I) = sRng(I).Offset(-1) Then
            If Rng Is Nothing Then
                Set Rng = sRng(I).Offset(1)
            Else
                Set Rng = Union(Rng, sRng(I).Offset(1))
            End If
        End If
    Next
    Rng.EntireRow.Insert Shift:=xlDown
End Sub
Cám ơn bạn đã giúp đỡ.
 
Web KT
Back
Top Bottom