các cao thủ giúp loại bỏ dữ liệu trùng, liền kề nhau (1 người xem)

Người dùng đang xem chủ đề này

em gửi lại file dữ liệu thật của em các bác giúp
em muốn kết quả trả đúng ở cột I chứ không phải vị trí khác, không thể dùng hàm tại vì cột I của em là kết quả của macro khác rồi nên đưa hàm vào khi chạy macro trước sẽ bị xóa sạch
kết quả của bác là loại bỏ tất cả dữ liệu trùng trong cột I, em đang cần là những dữ liệu nào liền kề nhau thôi nếu ngắt quãng là không tính, bác xem kết quả giống như ở cột L ý
 
Lần chỉnh sửa cuối:
em muốn kết quả trả đúng ở cột E chứ không phải vị trí khác, không thể dùng hàm tại vì cột E của em là kết quả của macro khác rồi nên đưa hàm vào khi chạy macro trước sẽ bị xóa sạch
kết quả của bác là loại bỏ tất cả dữ liệu trùng trong cột E, em đang cần là những dữ liệu nào liền kề nhau thôi nếu ngắt quãng là không tính, bác xem kết quả giống như ở cột K ý
Thử code này xem sao
kết quả dán vào cột I
Mã:
Public Sub Loai_Trung_Lien_Ke()
Dim DL, kq(), r As Long

DL = Sheet1.Range("E1:E19")
ReDim kq(1 To UBound(DL), 1 To 1)
kq(1, 1) = DL(1, 1)

For r = 2 To UBound(DL)
If DL(r, 1) = DL(r - 1, 1) Then
kq(r, 1) = ""
Else
kq(r, 1) = DL(r, 1)
End If
Next r

Sheet1.Range("I1").Resize(UBound(kq), 1).Value = kq
End Sub
 
em gửi lại file dữ liệu thật của em các bác giúp
em muốn kết quả trả đúng ở cột I chứ không phải vị trí khác, không thể dùng hàm tại vì cột I của em là kết quả của macro khác rồi nên đưa hàm vào khi chạy macro trước sẽ bị xóa sạch
kết quả của bác là loại bỏ tất cả dữ liệu trùng trong cột I, em đang cần là những dữ liệu nào liền kề nhau thôi nếu ngắt quãng là không tính, bác xem kết quả giống như ở cột L ý
 
em gửi lại file dữ liệu thật của em các bác giúp
em muốn kết quả trả đúng ở cột I chứ không phải vị trí khác, không thể dùng hàm tại vì cột I của em là kết quả của macro khác rồi nên đưa hàm vào khi chạy macro trước sẽ bị xóa sạch
kết quả của bác là loại bỏ tất cả dữ liệu trùng trong cột I, em đang cần là những dữ liệu nào liền kề nhau thôi nếu ngắt quãng là không tính, bác xem kết quả giống như ở cột L ý
 

File đính kèm

em gửi lại file dữ liệu thật của em các bác giúp
em muốn kết quả trả đúng ở cột I chứ không phải vị trí khác, không thể dùng hàm tại vì cột I của em là kết quả của macro khác rồi nên đưa hàm vào khi chạy macro trước sẽ bị xóa sạch
kết quả của bác là loại bỏ tất cả dữ liệu trùng trong cột I, em đang cần là những dữ liệu nào liền kề nhau thôi nếu ngắt quãng là không tính, bác xem kết quả giống như ở cột L ý

Thì trả về cột Ị rồi đấy thôi. Y boong yêu cầu.
Cũng không biết bạn đang trao đổi theo bài nào?
 
em gửi lại file dữ liệu thật của em các bác giúp
em muốn kết quả trả đúng ở cột I chứ không phải vị trí khác, không thể dùng hàm tại vì cột I của em là kết quả của macro khác rồi nên đưa hàm vào khi chạy macro trước sẽ bị xóa sạch
kết quả của bác là loại bỏ tất cả dữ liệu trùng trong cột I, em đang cần là những dữ liệu nào liền kề nhau thôi nếu ngắt quãng là không tính, bác xem kết quả giống như ở cột L ý

Code này là tôi làm theo file mẫu của bài 1 và kết quả là như cái cột L của bạn
Bạn thay đổi dữ liệu trong file mẫu thì không biết là muốn đánh giá code đúng sai theo cái file nào? ( Dữ liệu của bài 1 hay là của bài 6 )
---
Theo bài 1 thì chắc chắn là code này đúng đó bạn!
 
PHP:
Sub gido()
Dim rng As Range
Set rng = Range("E1:E25")
For i = rng.Rows.Count To 1 Step -1
    If rng(i + 1, 1).Value = rng(i).Value Then
        rng.Rows(i + 1) = Empty
    End If
Next
End Sub
đúng rồi bác nhưng em đính chính thêm chút là dữ liệu của em có bị ngắt quãng bằng ô trống, bác thể lọc qua được khoảng trống đó không
 
Code này là tôi làm theo file mẫu của bài 1 và kết quả là như cái cột L của bạn
Bạn thay đổi dữ liệu trong file mẫu thì không biết là muốn đánh giá code đúng sai theo cái file nào? ( Dữ liệu của bài 1 hay là của bài 6 )
---
Theo bài 1 thì chắc chắn là code này đúng đó bạn!
sr các bác em sửa lại ở bài 6 rồi
 
Thử code này xem sao
kết quả dán vào cột I
Mã:
Public Sub Loai_Trung_Lien_Ke()
Dim DL, kq(), r As Long

DL = Sheet1.Range("E1:E19")
ReDim kq(1 To UBound(DL), 1 To 1)
kq(1, 1) = DL(1, 1)

For r = 2 To UBound(DL)
If DL(r, 1) = DL(r - 1, 1) Then
kq(r, 1) = ""
Else
kq(r, 1) = DL(r, 1)
End If
Next r

Sheet1.Range("I1").Resize(UBound(kq), 1).Value = kq
End Sub
cột I của em dữ liệu có khoảng trống, thì nó không lọc, bác xem giúp em
 
em muốn tạo macro khác để lọc lại cột I chứ không muốn đưa kết quả ra vị trí khác, bác giúp em
PHP:
Sub CHIACHIA()
    Const NumberOfSpaceLines = 1
    
    Dim sAr As Variant, aDi As Variant, rAr As Variant
    Dim i As Long, n As Long, m As Long, k As Long
    Dim Sum As Double, tMp As Double
    Dim ceL As Range
    Dim bo As Boolean
    
    Set ceL = Sheet1.[A5]
    n = Sheet1.Rows.Count - ceL.Row
    sAr = Range(ceL, ceL.Offset(n).End(xlUp)).Resize(, 4).Value2
    aDi = Range(ceL.Offset(, 4), ceL.Offset(n, 4).End(xlUp)).Value2
    ReDim rAr(1 To n, 1 To 5)
    m = UBound(aDi)
    
    Sum = 0
    n = 0
    k = 1
    For i = 1 To UBound(sAr)
       tMp = sAr(i, 2)
       Do While tMp > 0
            n = n + 1
            rAr(n, 1) = sAr(i, 1)
            rAr(n, 3) = sAr(i, 3)
            rAr(n, 4) = sAr(i, 4)
            
            bo = k <= m
            If bo Then bo = Sum + tMp >= aDi(k, 1)
            If bo Then
                rAr(n, 2) = aDi(k, 1) - Sum
                rAr(n, 5) = aDi(k, 1)
                Sum = 0
                tMp = tMp - rAr(n, 2)
                n = n + NumberOfSpaceLines
                k = k + 1
            Else
                rAr(n, 2) = tMp
                Sum = Sum + tMp
                tMp = 0
            End If
       Loop
    Next i
    If Sum > 0 Then rAr(n, 5) = Sum
    
    With ceL.Offset(, 6)
        .Resize(65000, 5).ClearContents
        .Resize(n, 5) = rAr
    End With
    n = Sheet1.Range("G" & Rows.Count).End(xlUp).Row
    Sheet1.Range("M5:M" & n) = "=IF(COUNTIF($I$5:$I5,$I5)=1,$I5,"""")"
    Range("M5:M" & [M65000].End(xlUp).Row).copy
    Range("I5").PasteSpecial xlValues
    Columns("M:M").Delete
End Sub
BẠn xài tạm vậy, nói thật cách này chuối cả nải, hỏng cả code hay của Thầy Ba tê, thôi đợi thầy lên tìm cách khác nhé, hiện tại chưa có hướng làm hay, ghi tạm macro vậy
 
PHP:
Sub CHIACHIA()
    Const NumberOfSpaceLines = 1
    
    Dim sAr As Variant, aDi As Variant, rAr As Variant
    Dim i As Long, n As Long, m As Long, k As Long
    Dim Sum As Double, tMp As Double
    Dim ceL As Range
    Dim bo As Boolean
    
    Set ceL = Sheet1.[A5]
    n = Sheet1.Rows.Count - ceL.Row
    sAr = Range(ceL, ceL.Offset(n).End(xlUp)).Resize(, 4).Value2
    aDi = Range(ceL.Offset(, 4), ceL.Offset(n, 4).End(xlUp)).Value2
    ReDim rAr(1 To n, 1 To 5)
    m = UBound(aDi)
    
    Sum = 0
    n = 0
    k = 1
    For i = 1 To UBound(sAr)
       tMp = sAr(i, 2)
       Do While tMp > 0
            n = n + 1
            rAr(n, 1) = sAr(i, 1)
            rAr(n, 3) = sAr(i, 3)
            rAr(n, 4) = sAr(i, 4)
            
            bo = k <= m
            If bo Then bo = Sum + tMp >= aDi(k, 1)
            If bo Then
                rAr(n, 2) = aDi(k, 1) - Sum
                rAr(n, 5) = aDi(k, 1)
                Sum = 0
                tMp = tMp - rAr(n, 2)
                n = n + NumberOfSpaceLines
                k = k + 1
            Else
                rAr(n, 2) = tMp
                Sum = Sum + tMp
                tMp = 0
            End If
       Loop
    Next i
    If Sum > 0 Then rAr(n, 5) = Sum
    
    With ceL.Offset(, 6)
        .Resize(65000, 5).ClearContents
        .Resize(n, 5) = rAr
    End With
    n = Sheet1.Range("G" & Rows.Count).End(xlUp).Row
    Sheet1.Range("M5:M" & n) = "=IF(COUNTIF($I$5:$I5,$I5)=1,$I5,"""")"
    Range("M5:M" & [M65000].End(xlUp).Row).copy
    Range("I5").PasteSpecial xlValues
    Columns("M:M").Delete
End Sub
BẠn xài tạm vậy, nói thật cách này chuối cả nải, hỏng cả code hay của Thầy Ba tê, thôi đợi thầy lên tìm cách khác nhé, hiện tại chưa có hướng làm hay, ghi tạm macro vậy

rất tiếc code đó không phải code của thầy BaTe của bạn

@chủ topic: không hiểu bạn muốn gì nữa đây, và cao thủ là ai? để giúp bạn- hãy chú ý đặt tiêu đề
 
rất tiếc code đó không phải code của thầy BaTe của bạn

@chủ topic: không hiểu bạn muốn gì nữa đây, và cao thủ là ai? để giúp bạn- hãy chú ý đặt tiêu đề
Em thành thật xin lỗi, code của Bác đúng ko ah, Bác chỉnh giúp bạn ý nhé. em nghĩ bài này ko làm khó Bác Giola được
 
Em thành thật xin lỗi, code của Bác đúng ko ah, Bác chỉnh giúp bạn ý nhé. em nghĩ bài này ko làm khó Bác Giola được

Khó thì không có gì khó với cả bạn nếu đó đã từng code của chính ta, nhưng tôi không thích người hỏi không chuẩn bị câu hỏi của mình cứ vội vàng đưa câu hỏi, sau đó lại thêm thêm các yêu cầu,

Gửi các bạn hỏi: hãy suy nghĩ kỹ và đặt câu hỏi đầy đủ từ đầu, yêu cầu từ đầu, đưa ví dụ dữ liệu một cách tường minh (dữ liệu thật là tốt, nhưng chưa chắc đã tốt hẳn mà dữ liệu phải phỏng theo tất cả khả năng xảy ra trong thực tế ) như thế mới tiết kiệm thời gian cho cả người giúp lẫn bản thân mình
 
Khó thì không có gì khó với cả bạn nếu đó đã từng code của chính ta, nhưng tôi không thích người hỏi không chuẩn bị câu hỏi của mình cứ vội vàng đưa câu hỏi, sau đó lại thêm thêm các yêu cầu,

Gửi các bạn hỏi: hãy suy nghĩ kỹ và đặt câu hỏi đầy đủ từ đầu, yêu cầu từ đầu, đưa ví dụ dữ liệu một cách tường minh (dữ liệu thật là tốt, nhưng chưa chắc đã tốt hẳn mà dữ liệu phải phỏng theo tất cả khả năng xảy ra trong thực tế ) như thế mới tiết kiệm thời gian cho cả người giúp lẫn bản thân mình
Bác rất thẳng thắn. Bác nói rất đúng không riêng gì topic này, là bài học để mọi người cùng rút kinh nghiệm, để chuẩn bị câu hỏi tốt hơn
 
em gửi lại file dữ liệu thật của em các bác giúp
em muốn kết quả trả đúng ở cột I chứ không phải vị trí khác, không thể dùng hàm tại vì cột I của em là kết quả của macro khác rồi nên đưa hàm vào khi chạy macro trước sẽ bị xóa sạch
kết quả của bác là loại bỏ tất cả dữ liệu trùng trong cột I, em đang cần là những dữ liệu nào liền kề nhau thôi nếu ngắt quãng là không tính, bác xem kết quả giống như ở cột L ý

thay sub CHIACHIA trong module2 ở file post #6 thành như sau, là đạt kết quả như ý (chú ý cho đề tài tiếp theo, hãy chuẩn bị kỹ trước khi hỏi)
PHP:
Sub CHIACHIA()
    Const NumberOfSpaceLines = 1
    
    Dim sAr As Variant, aDi As Variant, rAr As Variant
    Dim i As Long, n As Long, m As Long, k As Long
    Dim Sum As Double, tMp As Double
    Dim ceL As Range
    Dim bo As Boolean, boK As Boolean
    
    Set ceL = Sheet1.[A5]
    n = Sheet1.Rows.Count - ceL.Row
    sAr = Range(ceL, ceL.Offset(n).End(xlUp)).Resize(, 4).Value2
    aDi = Range(ceL.Offset(, 4), ceL.Offset(n, 4).End(xlUp)).Value2
    ReDim rAr(1 To n, 1 To 5)
    m = UBound(aDi)
    
    Sum = 0
    n = 0
    k = 1
    For i = 1 To UBound(sAr)
       tMp = sAr(i, 2)
       boK = True
       Do While tMp > 0
            n = n + 1
            rAr(n, 1) = sAr(i, 1)
            If boK Then rAr(n, 3) = sAr(i, 3)
            rAr(n, 4) = sAr(i, 4)
            
            bo = k <= m
            If bo Then bo = Sum + tMp >= aDi(k, 1)
            If bo Then
                rAr(n, 2) = aDi(k, 1) - Sum
                rAr(n, 5) = aDi(k, 1)
                Sum = 0
                tMp = tMp - rAr(n, 2)
                n = n + NumberOfSpaceLines
                k = k + 1
            Else
                rAr(n, 2) = tMp
                Sum = Sum + tMp
                tMp = 0
            End If
            boK = False
       Loop
    Next i
    If Sum > 0 Then rAr(n, 5) = Sum
    
    With ceL.Offset(, 6)
        .Resize(65000, 5).ClearContents
        .Resize(n, 5) = rAr
    End With
End Sub
 
Khó thì không có gì khó với cả bạn nếu đó đã từng code của chính ta, nhưng tôi không thích người hỏi không chuẩn bị câu hỏi của mình cứ vội vàng đưa câu hỏi, sau đó lại thêm thêm các yêu cầu,

Gửi các bạn hỏi: hãy suy nghĩ kỹ và đặt câu hỏi đầy đủ từ đầu, yêu cầu từ đầu, đưa ví dụ dữ liệu một cách tường minh (dữ liệu thật là tốt, nhưng chưa chắc đã tốt hẳn mà dữ liệu phải phỏng theo tất cả khả năng xảy ra trong thực tế ) như thế mới tiết kiệm thời gian cho cả người giúp lẫn bản thân mình
xin rút kinh nghiệm, thank bác
 
em muốn tạo macro khác để lọc lại cột I chứ không muốn đưa kết quả ra vị trí khác, bác giúp em

tôi mượn code bài 12 nha
tốt nhất là nhờ bác bate viết thêm vô code hôm trước...hehehhh
Mã:
Public Sub Loai_Trung_Lien_Ke()
Dim DL, r As Long

DL = Sheet1.Range("I5:I1000")
tam = DL(1, 1)

For r = 2 To UBound(DL)
If Not IsEmpty(DL(r, 1)) Then
    If DL(r, 1) = tam Then
        DL(r, 1) = ""
    Else
        tam = DL(r, 1)
    End If
End If
Next r

Sheet1.[I5].Resize(UBound(DL)).Value = DL
End Sub
 
thay sub CHIACHIA trong module2 ở file post #6 thành như sau, là đạt kết quả như ý (chú ý cho đề tài tiếp theo, hãy chuẩn bị kỹ trước khi hỏi)
PHP:
Sub CHIACHIA()
    Const NumberOfSpaceLines = 1
    
    Dim sAr As Variant, aDi As Variant, rAr As Variant
    Dim i As Long, n As Long, m As Long, k As Long
    Dim Sum As Double, tMp As Double
    Dim ceL As Range
    Dim bo As Boolean, boK As Boolean
    
    Set ceL = Sheet1.[A5]
    n = Sheet1.Rows.Count - ceL.Row
    sAr = Range(ceL, ceL.Offset(n).End(xlUp)).Resize(, 4).Value2
    aDi = Range(ceL.Offset(, 4), ceL.Offset(n, 4).End(xlUp)).Value2
    ReDim rAr(1 To n, 1 To 5)
    m = UBound(aDi)
    
    Sum = 0
    n = 0
    k = 1
    For i = 1 To UBound(sAr)
       tMp = sAr(i, 2)
       boK = True
       Do While tMp > 0
            n = n + 1
            rAr(n, 1) = sAr(i, 1)
            If boK Then rAr(n, 3) = sAr(i, 3)
            rAr(n, 4) = sAr(i, 4)
            
            bo = k <= m
            If bo Then bo = Sum + tMp >= aDi(k, 1)
            If bo Then
                rAr(n, 2) = aDi(k, 1) - Sum
                rAr(n, 5) = aDi(k, 1)
                Sum = 0
                tMp = tMp - rAr(n, 2)
                n = n + NumberOfSpaceLines
                k = k + 1
            Else
                rAr(n, 2) = tMp
                Sum = Sum + tMp
                tMp = 0
            End If
            boK = False
       Loop
    Next i
    If Sum > 0 Then rAr(n, 5) = Sum
    
    With ceL.Offset(, 6)
        .Resize(65000, 5).ClearContents
        .Resize(n, 5) = rAr
    End With
End Sub
thành thật xin lỗi bác lại phiền bác thêm lần nữa, vì cái bài này mà em bị luẩn quẩn up nhầm file cũ, bây giờ cột E dữ liệu em nhập nếu bị ngắt quãng có khoảng trống thì kết quả ra tương ứng với khoảng trống là 0
bác giúp em cột E có thể chứa dữ liệu không liên tục, có khoảng trống như lần trước bác làm ý
 
thành thật xin lỗi bác lại phiền bác thêm lần nữa, vì cái bài này mà em bị luẩn quẩn up nhầm file cũ, bây giờ cột E dữ liệu em nhập nếu bị ngắt quãng có khoảng trống thì kết quả ra tương ứng với khoảng trống là 0
bác giúp em cột E có thể chứa dữ liệu không liên tục, có khoảng trống như lần trước bác làm ý

Đúng là dây rút kinh nghiệm của chúng ta (ng VN) dài quá dài quá, rút mãi không hết. Nhưng ở đây nhầm lẫn là chuyện thường, tôi cũng không để ý code đó là code version cũ hơn.

Đây là code bạn mong muốn,

PHP:
Sub CHIACHIA()
    Const NumberOfSpaceLines = 1
    Dim sAr As Variant, aDi As Variant, rAr As Variant
    Dim i As Long, n As Long, m As Long, k As Long, nR As Long
    Dim Sum As Double, tMp As Double
    Dim ceL As Range
    Dim bo As Boolean
    
    Set ceL = Sheet1.[A5]
    nR = Sheet1.Rows.Count - ceL.Row
    sAr = Range(ceL, ceL.Offset(nR).End(xlUp)).Resize(, 4).Value2
    aDi = Range(ceL.Offset(, 4), ceL.Offset(nR, 4).End(xlUp)).Value2
    ReDim rAr(1 To nR, 1 To 5)
    n = UBound(aDi)
    
    m = 0
    For i = 1 To n
        If aDi(i, 1) > 0 Then
            m = m + 1
            aDi(m, 1) = aDi(i, 1)
        End If
    Next
    
    k = 1
    Sum = 0
    n = 0
    For i = 1 To UBound(sAr)
       tMp = sAr(i, 2)
       If tMp > 0 Then rAr(n + 1, 3) = sAr(i, 3)
       Do While tMp > 0
            n = n + 1
            rAr(n, 1) = sAr(i, 1)
            rAr(n, 4) = sAr(i, 4)
            
            bo = k <= m
            If bo Then bo = Sum + tMp >= aDi(k, 1)
            If bo Then
                rAr(n, 2) = aDi(k, 1) - Sum
                rAr(n, 5) = aDi(k, 1)
                Sum = 0
                tMp = tMp - rAr(n, 2)
                n = n + NumberOfSpaceLines
                k = k + 1
            Else
                rAr(n, 2) = tMp
                Sum = Sum + tMp
                tMp = 0
            End If
       Loop
    Next i
    If Sum > 0 Then rAr(n, 5) = Sum
    
    With ceL.Offset(, 6)
        .Resize(nR, 5).ClearContents
        .Resize(n, 5) = rAr
    End With
End Sub
 

Bài viết mới nhất

Back
Top Bottom