Chỉ giáo cách lọc ra các dãy số liền nhau

Liên hệ QC
minhquang039

minhquang039

Thành viên mới
Tham gia
14/8/19
Bài viết
8
Được thích
1
Dear các anh, chị.
Hiện tại mình đang gặp 1 bài toán khó quá, 2 ngày rồi chưa xử được, mà sếp thì cứ thúc vào đít, hic hic. Nhờ anh chị chỉ giáo hộ với ạ
Mình hiện có 1 dãy số lộn xộn, giờ có cách nào để hiển thị ra được các dãy số liền nhau trong dãy số tổng không ạ. Ý tưởng mình là dùng hàm IF để hiện thị loại dãy ra, sau đó dùng pivot để đếm từng loại dãy liền nhau, nhưng không tài nào dùng được hàm if.
VD: dãy số đơn giản: 1,2,5,6,7,10,11,14,15,16,19,20,21,22. Làm sao để mình đếm ra được có 2 dãy số liền 2(1-2 & 10-11), 2 dãy liền 3(5-6-7& 14-15-16), 1 dãy liền 4(19-20-21-22). kiểu mình đang cần là vây đấy ạ.
Mình có đính kèm file. Trong đó dãy số mình cần lọc là dãy B:B đấy ạ. Các cái sau là mình ráng làm thử, mà ko thành công. Nhờ anh chị chỉ giáo với ạ. :( :(
file nặng quá, mình up lên drive cho mọi người tham khảo ạ

report_status_082018.rar

drive.google.com drive.google.com
222817
 
Lần chỉnh sửa cuối:
File đâu bạn, hình không vậy ?
 
minhquang039 đã viết:
Dear các anh, chị.
Hiện tại mình đang gặp 1 bài toán khó quá, 2 ngày rồi chưa xử được, mà sếp thì cứ thúc vào đít, hic hic. Nhờ anh chị chỉ giáo hộ với ạ
Mình hiện có 1 dãy số lộn xộn, giờ có cách nào để hiển thị ra được các dãy số liền nhau trong dãy số tổng không ạ. Ý tưởng mình là dùng hàm IF để hiện thị loại dãy ra, sau đó dùng pivot để đếm từng loại dãy liền nhau, nhưng không tài nào dùng được hàm if.
VD: dãy số đơn giản: 1,2,5,6,7,10,11,14,15,16,19,20,21,22. Làm sao để mình đếm ra được có 2 dãy số liền 2(1-2 & 10-11), 2 dãy liền 3(5-6-7& 14-15-16), 1 dãy liền 4(19-20-21-22). kiểu mình đang cần là vây đấy ạ.
Mình có đính kèm file. Trong đó dãy số mình cần lọc là dãy B:B đấy ạ. Các cái sau là mình ráng làm thử, mà ko thành công. Nhờ anh chị chỉ giáo với ạ. :( :(
file nặng quá, mình up lên drive cho mọi người tham khảo ạ

report_status_082018.rar

drive.google.com drive.google.com
View attachment 222817
Nhấp chuột vào đây để mở rộng...
Chèn thêm sheet2 rồi chạy code
Mã: 
Sub LienTuc_()
Dim Nguon, Dong
Dim KQ
Dim i, j, k, x, z, t
Nguon = Sheet1.Range("A1", Sheet1.Range("A" & Rows.Count).End(xlUp))
Dong = UBound(Nguon)
ReDim KQ(1 To Dong \ 2 + 1, 1 To 3)
i = 2
Do While i < Dong
    k = 1
    For j = i + 1 To Dong
        If Nguon(j, 1) = Nguon(j - 1, 1) + 1 Then
            k = k + 1
        Else
            If k > 1 Then
                x = x + 1
                KQ(x, 1) = k
                KQ(x, 3) = Nguon(i, 1) & "_" & Nguon(j - 1, 1)
            End If
            i = j
            Exit For
        End If
    Next j
Loop
With Sheet2
    .UsedRange.ClearContents
    .Range("A3").Resize(x, UBound(KQ, 2)) = KQ
    .Range("A3").Resize(x, UBound(KQ, 2)).Columns.AutoFit
End With
End Sub
---
Đã xóa lỗi mảng Dem()
 
Lần chỉnh sửa cuối:
CHAOQUAY đã viết:
Chèn thêm sheet2 rồi chạy code
Mã: 
Sub LienTuc_()
Dim Nguon, Dong
Dim KQ
Dim i, j, k, x, z, t
Nguon = Sheet1.Range("A1", Sheet1.Range("A" & Rows.Count).End(xlUp))
Dong = UBound(Nguon)
ReDim KQ(1 To Dong \ 2 + 1, 1 To 3)
i = 2
Do While i < Dong
    k = 1
    For j = i + 1 To Dong
        If Nguon(j, 1) = Nguon(j - 1, 1) + 1 Then
            k = k + 1
        Else
            If k > 1 Then
                Dem(k) = Dem(k) + 1
                x = x + 1
                KQ(x, 1) = k
                KQ(x, 3) = Nguon(i, 1) & "_" & Nguon(j - 1, 1)
            End If
            i = j
            Exit For
        End If
    Next j
Loop
With Sheet2
    .UsedRange.ClearContents
    .Range("A3").Resize(x, UBound(KQ, 2)) = KQ
    .Range("A3").Resize(x, UBound(KQ, 2)).Columns.AutoFit
End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cái biến Dem(k) ko khai báo gây ra lỗi.
 
CHAOQUAY đã viết:
Chèn thêm sheet2 rồi chạy code
Mã: 
Sub LienTuc_()
Dim Nguon, Dong
Dim KQ
Dim i, j, k, x, z, t
Nguon = Sheet1.Range("A1", Sheet1.Range("A" & Rows.Count).End(xlUp))
Dong = UBound(Nguon)
ReDim KQ(1 To Dong \ 2 + 1, 1 To 3)
i = 2
Do While i < Dong
    k = 1
    For j = i + 1 To Dong
        If Nguon(j, 1) = Nguon(j - 1, 1) + 1 Then
            k = k + 1
        Else
            If k > 1 Then
                x = x + 1
                KQ(x, 1) = k
                KQ(x, 3) = Nguon(i, 1) & "_" & Nguon(j - 1, 1)
            End If
            i = j
            Exit For
        End If
    Next j
Loop
With Sheet2
    .UsedRange.ClearContents
    .Range("A3").Resize(x, UBound(KQ, 2)) = KQ
    .Range("A3").Resize(x, UBound(KQ, 2)).Columns.AutoFit
End With
End Sub
---
Đã xóa lỗi mảng Dem()
Nhấp chuột vào đây để mở rộng...
quá hay, thanks bạn rất nhiều. Chắc đợt này về phải học VBA :D
Bài đã được tự động gộp:

CHAOQUAY đã viết:
Chèn thêm sheet2 rồi chạy code
Mã: 
Sub LienTuc_()
Dim Nguon, Dong
Dim KQ
Dim i, j, k, x, z, t
Nguon = Sheet1.Range("A1", Sheet1.Range("A" & Rows.Count).End(xlUp))
Dong = UBound(Nguon)
ReDim KQ(1 To Dong \ 2 + 1, 1 To 3)
i = 2
Do While i < Dong
    k = 1
    For j = i + 1 To Dong
        If Nguon(j, 1) = Nguon(j - 1, 1) + 1 Then
            k = k + 1
        Else
            If k > 1 Then
                x = x + 1
                KQ(x, 1) = k
                KQ(x, 3) = Nguon(i, 1) & "_" & Nguon(j - 1, 1)
            End If
            i = j
            Exit For
        End If
    Next j
Loop
With Sheet2
    .UsedRange.ClearContents
    .Range("A3").Resize(x, UBound(KQ, 2)) = KQ
    .Range("A3").Resize(x, UBound(KQ, 2)).Columns.AutoFit
End With
End Sub
---
Đã xóa lỗi mảng Dem()
Nhấp chuột vào đây để mở rộng...
với sẵn bạn cho hỏi thêm 1 cái nữa. Mình có tham khảo cách để hiện các số còn thiếu trong dãy ra bằng hàm thôi, ko cần viết code. Có 1 bài trên page đã chỉ: nhưng mình chưa hiểu chỗ "Dkloc" là ntn ? Nếu có thể, hướng dẫn giúp mình chỗ này luôn ạ. Thanks bạn nhiều
222871
 
Lần chỉnh sửa cuối:
minhquang039 đã viết:
quá hay, Cảm ơn bạn rất nhiều. Chắc đợt này về phải học VBA :D
Bài đã được tự động gộp:


với sẵn bạn cho hỏi thêm 1 cái nữa. Mình có tham khảo cách để hiện các số còn thiếu trong dãy ra bằng hàm thôi, ko cần viết code. Có 1 bài trên page đã chỉ: nhưng mình chưa hiểu chỗ "Dkloc" là ntn ? Nếu có thể, hướng dẫn giúp mình chỗ này luôn ạ. Cảm ơn bạn nhiều
View attachment 222871
Nhấp chuột vào đây để mở rộng...
Công thức trong hình của bạn có lẽ là họ dùng name. Nếu muốn tìm hiểu công thức, bạn nhấn ctrl+F3. Nhìn trong bảng hiển thị, nếu có tên DkLoc thì nhấp vào đó, sẽ thấy công thức bên dưới chỗ refers to. Nếu cần thì copy công thức ra ngoài để tìm hiểu.
File của bạn >800.000 dòng, dùng công thức có lẽ chịu không nổi.
 
CHAOQUAY đã viết:
Công thức trong hình của bạn có lẽ là họ dùng name. Nếu muốn tìm hiểu công thức, bạn nhấn ctrl+F3. Nhìn trong bảng hiển thị, nếu có tên DkLoc thì nhấp vào đó, sẽ thấy công thức bên dưới chỗ refers to. Nếu cần thì copy công thức ra ngoài để tìm hiểu.
File của bạn >800.000 dòng, dùng công thức có lẽ chịu không nổi.
Nhấp chuột vào đây để mở rộng...
hay quá, mình đang tìm hiểu thêm. Cảm ơn bạn nhiều. Bạn giỏi thật. Nếu có thể kết nối với bạn qua kênh nào khác tiện hơn để học hỏi thì xin cho mình infor nhé. thanks lần nữa
 
@minhquang039
Code bài 4 còn thiếu điều kiện dừng như góp ý của bác @batman1 bài 10.
Bạn lấy code dưới đây thay code bài trên.
Mã: 
Sub LienTuc__()
Dim Nguon, Dong
Dim KQ
Dim i, j, k, x, z, t
Nguon = Sheet1.Range("A1", Sheet1.Range("A" & Rows.Count).End(xlUp))
Dong = UBound(Nguon)
ReDim KQ(1 To Dong \ 2 + 1, 1 To 3)
i = 2
Do While i < Dong
    k = 1
    For j = i + 1 To Dong
        If Nguon(j, 1) = Nguon(j - 1, 1) + 1 Then
            k = k + 1
        Else
            Exit For
        End If
    Next j
    If k > 1 Then
        x = x + 1
        KQ(x, 1) = k
        KQ(x, 3) = Nguon(i, 1) & "_" & Nguon(i + k - 1, 1)
    End If
    i = i + k
Loop
With Sheet2
    .UsedRange.ClearContents
    .Range("A3").Resize(x, UBound(KQ, 2)) = KQ
    .Range("A3").Resize(x, UBound(KQ, 2)).Columns.AutoFit
End With
End Sub
 
Cột phụ:
Nếu số không liên tục theo số trước nó, =1
Nếu liên tục theo số trước nó, =trị trước đó + 1

J2 = 1
J3 = IF($B3=$B2+1, $J2+1, 1)
Hoặc là:
J2 = IFERROR(IF($B2=$B1+1, $J1+1, 1), 1)

Cột chính (tức là cột lấy kết quả). Xét cột số đếm. Nếu số đếm nó lớn hơn trị kế nó thì nó là một dãy liên tiếp.
K2 = IF($J2 > $J3, $J2, "")

Nếu dùng code VBA thì đại khái cũng theo giải thuật ấy.
 
Lần chỉnh sửa cuối:
VetMini đã viết:
Cột phụ:
Nếu số không liên tục theo số trước nó, =1
Nếu liên tục theo số trước nó, =trị trước đó + 1

J2 = 1
J3 = IF($B3=$B2+1, $J2+1, 1)
Hoặc là:
J2 = IFERROR(IF($B2=$B1+1, $J1+1, 1), 1)

Cột chính (tức là cột lấy kết quả). Xét cột số đếm. Nếu số đếm nó lớn hơn trị kế nó thì nó là một dãy liên tiếp.
K2 = IF($J2 > $J3, $J2, "")

Nếu dùng code VBA thì đại khái cũng theo giải thuật ấy.
Nhấp chuột vào đây để mở rộng...
Cột K của bác vẫn là cột phụ vì hình như chủ thớt cần kết quả dạng (hoặc cả dạng) 1-2 & 10-11, Tức không chỉ là số các số liên tiếp mà là liệt kê khoảng.
Ngoài ra tôi không hiểu
Mình hiện có 1 dãy số lộn xộn
Nhấp chuột vào đây để mở rộng...

Một dãy được sắp xếp thì có lẽ không thể gọi là lộn xộn. Mà nếu đúng là dãy có thể không được sắp xếp thì code hay công thức trong chủ đề này đều tèo. Tôi không tham gia chủ đề cũng là vì chủ thớt không mô tả dữ liệu. Không nói rõ thêm ra 1 câu. Vd. nếu là dãy có thể không được sắp xếp mà 1, 2, 3 xuất hiện không liền nhau thì 1-3 có được coi là kết quả không.

Chỉ cần vd. 1 câu: "Tôi có dãy sắp xếp tăng dần". Lúc đó người khác không phải lăn tăn, đoán ý ...
 
Góp vui, sắp xếp cột A tăng dần trước khi chạy code
PHP: 
Sub GhepSoLienTuc()
Dim sArr(), dArr()
Dim i&, j&, k&, lr&
Dim sID&, eID&
With Sheet1
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    sArr = .Range("A2:A" & lr + 1).Value
    lr = UBound(sArr)
End With
ReDim dArr(1 To lr / 2, 1 To 2)
    For i = 1 To lr
        If sArr(i, 1) - k = sID Then
            k = k + 1
            eID = sArr(i, 1)
        Else
            If k > 1 Then
                j = j + 1
                dArr(j, 1) = k
                dArr(j, 2) = sID & " _ " & eID
            End If
                k = 1
                sID = sArr(i, 1)
        End If
    Next i
If j > 0 Then Sheet2.Range("A3").Resize(j, 2) = dArr
End Sub
 
minhquang039 đã viết:
quá hay, Cảm ơn bạn rất nhiều. Chắc đợt này về phải học VBA :D
Bài đã được tự động gộp:


với sẵn bạn cho hỏi thêm 1 cái nữa. Mình có tham khảo cách để hiện các số còn thiếu trong dãy ra bằng hàm thôi, ko cần viết code. Có 1 bài trên page đã chỉ: nhưng mình chưa hiểu chỗ "Dkloc" là ntn ? Nếu có thể, hướng dẫn giúp mình chỗ này luôn ạ. Cảm ơn bạn nhiều
View attachment 222871
Nhấp chuột vào đây để mở rộng...
BẠN ƠI. bây giờ bài toán của mình lại đúng theo bài toán này. Hiển thị ra những số thiếu trong dãy số đó. Nhưng mình ko tài nào hiểu và dùng được file này. Cứ mình thay số của mình vào la công thức trong file này ko chạy. Bạn có thể hỗ trợ mình 1 lần nữa ko ạ. Cảm ơn bạn rất nhiều nếu có thể giúp.
 

File đính kèm

  • Loc So Khong Co.xls
    41 KB · Đọc: 9
minhquang039 đã viết:
BẠN ƠI. bây giờ bài toán của mình lại đúng theo bài toán này. Hiển thị ra những số thiếu trong dãy số đó. Nhưng mình ko tài nào hiểu và dùng được file này. Cứ mình thay số của mình vào la công thức trong file này ko chạy. Bạn có thể hỗ trợ mình 1 lần nữa ko ạ. Cảm ơn bạn rất nhiều nếu có thể giúp.
Nhấp chuột vào đây để mở rộng...
Dùng cột phụ cho nhẹ file
Tại D1, nhập công thức, copy xuống cuối vùng dữ liệu
Mã: 
=IF(COUNTIF($A$2:$A$379,ROW())=0,ROW(),"")
Tại B2, nhập công thức, copy tương tự
Mã: 
=IFERROR(SMALL($D$1:$D$379,ROWS($B$2:B2)),"")
Xong việc nếu cần thì ẩn cột D
 
CHAOQUAY đã viết:
Dùng cột phụ cho nhẹ file
Tại D1, nhập công thức, copy xuống cuối vùng dữ liệu
Mã: 
=IF(COUNTIF($A$2:$A$379,ROW())=0,ROW(),"")
Tại B2, nhập công thức, copy tương tự
Mã: 
=IFERROR(SMALL($D$1:$D$379,ROWS($B$2:B2)),"")
Xong việc nếu cần thì ẩn cột D
Nhấp chuột vào đây để mở rộng...
mình mới nhập 1 công thức thôi, đứng máy luôn rồi :))), khổ ghê :( :(
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
2
Trả lời
20
Đọc
283
Hoàng Tuấn 868
H
V
Tách chuỗi bất kỳ vào các cột khi gặp ký tự -
Trả lời
5
Đọc
131
DeTong
D
1
Xin hỗ trợ về tính tổng các dòng loại trừ dòng ẩn nhưng các dòng không liền nhau
Trả lời
3
Đọc
49
198zxc
1
Q
trả lời google form bằng VBA excel
Trả lời
1
Đọc
33
befaint
befaint
phammaihuong90
Hàm tìm ngày gần nhất đạt được số lượng mục tiêu
Trả lời
6
Đọc
147
phammaihuong90
phammaihuong90
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom