Giúp mình tìm chuỗi thỏa điều kiện (mình gọi là tìm chuỗi Bit).

Chia sẻ bởi:hands

★★★★★

‹ [Chia sẻ] Hàm UDF tìm số lớn... Lấy dữ liệu từ Web ›

Quảng cáo

Các bạn giúp mình giải quyết bài toán này với:

Một chuỗi bit được định nghĩa như sau:
Bắt đầu từ dòng đầu tiên trên cùng của bảng dò xuống tới dòng cuối cùng nhé!
Không định nghĩa chuỗi 1 bit.
Chuỗi 2 bit: Bắt đầu là số 1 và một số 0 ở sau, kết thúc là một số khác 0 (kết thúc là 1, 2, 3, 4,…, gì đó cũng được).
Chuỗi 3 bit: Bắt đầu là số 1 và 2 số0 ở sau, kết thúc là một số khác 0 (kết thúc là 1, 2, 3, 4,…, gì đó cũng được).
Chuỗi 4 bit: Bắt đầu là số 1 và 3 số 0 ở sau, kết thúc là một số khác 0 (kết thúc là 1, 2, 3, 4,…, gì đó cũng được).
……………………………………………….
Chuỗi n bit: Bắt đầu là số 1 và n-1 số 0 ở sau, kết thúc là một số khác 0 (kết thúc là 1, 2, 3, 4,…, gì đó cũng được).

Các bạn chịu khó xem ví dụ minh họa nhé. Một chuỗi luôn bắt đầu là số 1 và kết thúc phải là số khác 0.
2226
Cám ơn các bạn giúp đỡ.

Nhấn alt + F8 chạy macro trong file đính kèm

Option Explicit

Sub dotim()
Dim Nguon
Dim rws, i, j, k

Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown))
rws = UBound(Nguon)
With CreateObject("Scripting.Dictionary")
    i = 1
    Do While i < rws
        k = 1
        If Nguon(i, 1) = 1 Then
            If Nguon(i + 1, 1) = 0 Then
                k = 1
                For j = i + 1 To rws
                    If Nguon(j, 1) = 0 Then
                        k = k + 1
                    Else
                        Exit For
                    End If
                Next j
                .Item("Chuoi " & k) = .Item("Chuoi " & k) + 1
            End If
        End If
        i = i + k
    Loop
    Sheet1.Range("D2").Resize(.Count, 1) = Application.Transpose(.keys)
    Sheet1.Range("E2").Resize(.Count, 1) = Application.Transpose(.items)
End With
End Sub

www.giaiphapexcel.com/diendan/threads/gi%C3%BAp-m%C3%ACnh-t%C3%ACm-chu%E1%BB%97i-th%E1%BB%8Fa-%C4%91i%E1%BB%81u-ki%E1%BB%87n-m%C3%ACnh-g%E1%BB%8Di-l%C3%A0-t%C3%ACm-chu%E1%BB%97i-bit.157650/#post-1046346

Khóa học SprinGO phù hợp

Khóa học Power PI – Ứng dung trong Nhân sự

TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...

Xem khóa học

★★★★★ 5 ★ 1 👤 1 ▥ 0

‹ [Chia sẻ] Hàm UDF tìm số lớn gần... Lấy dữ liệu từ Web ›

Quảng cáo

Bạn nên đọc

Tìm ngày giờ kết thúc dự kiến

Tổng hợp file Excel tính giá thành sản phẩm cho doanh nghiệp sản xuất, gia công, xây lắp

Hướng dẫn xử lý file Excel chậm

Công thức quy đổi lương NET sang GROSS

Tính thưởng lũy tiến

Cách tách chuỗi trong dấu ngoặc Excel bằng công thức và Flash Fill

One Response

hands says:

19/01/2023 at 9:16 am

Giải thuật dễ dùng:
1. Ghi số thứ tự vào cột bên cạnh.
2. Filter, bỏ số 0
3. copy visible cells vào một mảng (n dòng, 2 cột)
4. đọc mảng. Cứ thấy số 1 ở cột 1 là bắt đầu một số, dòng kế tiếp là kết số ấy (số gì cũng được). Số 0's ở giữa là hiệu số cột 2 trừ 1.

Chạy code

Sub XYZ()
  Dim dic As Object, sArr(), sRow&, i&, k&

sArr = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown)).Value
  sRow = UBound(sArr)
  With CreateObject("Scripting.Dictionary")
    For i = 3 To sRow
      If sArr(i - 2, 1) = 1 And sArr(i - 1, 1) = 0 Then k = 2
      If k > 0 Then
        If sArr(i, 1) = 0 Then
           k = k + 1
        Else
          .Item("Chuoi " & k) = .Item("Chuoi " & k) + 1
          k = 0
        End If
      End If
    Next i
    i = .Count
    If i > 0 Then
      Sheet1.Range("D2").Resize(i) = Application.Transpose(.keys)
      Sheet1.Range("E2").Resize(i) = Application.Transpose(.items)
    End If
  End With
End Sub

Chạy code

Bạn dùng công thức này ở C2, bấm Ctrl+Shift+Enter
C2=SUM(IFERROR(--(FREQUENCY(-ROW($1:$49),-IF($A$2:$A$50,ROW($1:$49),10^6))*($A$2:$A$50=1)=ROW(A2)),))

Sub test()
Dim r As Long, lastRow As Long, start As Long, dulieu(), result(1 To 14, 1 To 1)
    With Sheet1
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        If lastRow < 4 Then Exit Sub
        dulieu = .Range("A2:A" & lastRow).Value
    End With
    start = -10 ^ 6
    For r = 2 To UBound(dulieu, 1) - 1
        If dulieu(r, 1) = 0 Then
            If dulieu(r - 1, 1) = 1 Then start = r - 1
            If dulieu(r + 1, 1) > 0 Then
                If r - start <= 14 Then
                    result(r - start, 1) = result(r - start, 1) + 1
                    start = -10 ^ 6
                End If
            End If
        End If
    Next r
    Sheet1.Range("C2").Resize(UBound(result, 1)).Value = result
End Sub