Tìm số cột liên tiếp nhiều nhất có chứa dữ liệu

SA_DQ · 6/9/15

Bạn, mình chạy cái này mất nhiều thời gian quá mà vẫn chưa xong bạn ạ! Không biết bạn có cách nào cải tiến tốc độ được không ạ? Xin cảm ơn!

* Bỏ trộn các ô cột [B:B]
* Cho chạy macro này nhiều lần:

PHP:

Option Explicit
Sub ChayNhièuLàn()
 Dim fRw As Long, W As Long, Tmr#, Rws As Long
    
 Tmr = Timer():                             [b3].Value = "GPE.COM"
 Application.ScreenUpdating = False
 Rws = [E4].End(xlDown).Row
 fRw = Cells(Cells.Rows.Count, "B").End(xlUp).Row + 1
 
 For W = fRw To fRw + 65500
    Cells(W, "B").Value = MaxBlanks(Cells(W, "E").Resize(, 101))
    If Cells(W + 1, "E").Value = "" Then
        [b3].Value = Timer() - Tmr:        Exit For
    End If
 Next W
 Application.ScreenUpdating = True
End Sub

hcl_pt · 6/9/15

HYen17 đã viết:

* Bỏ trộn các ô cột [B:B]
* Cho chạy macro này nhiều lần:

PHP:

Option Explicit
Sub ChayNhièuLàn()
 Dim fRw As Long, W As Long, Tmr#, Rws As Long
    
 Tmr = Timer():                             [b3].Value = "GPE.COM"
 Application.ScreenUpdating = False
 Rws = [E4].End(xlDown).Row
 fRw = Cells(Cells.Rows.Count, "B").End(xlUp).Row + 1
 
 For W = fRw To fRw + 65500
    Cells(W, "B").Value = MaxBlanks(Cells(W, "E").Resize(, 101))
    If Cells(W + 1, "E").Value = "" Then
        [b3].Value = Timer() - Tmr:        Exit For
    End If
 Next W
 Application.ScreenUpdating = True
End Sub

Cảm ơn bạn, mình đã thực hiện chạy và báo lỗi : "can not execute code in break mode" và
báo vàng ở Cells(W, "B").Value = MaxBlanks(Cells(W, "E").Resize(, 101)) - Mong các bạn xem giúp! Xin cảm ơn rất nhiều!

SA_DQ · 6/9/15

https://support.microsoft.com/en-us/kb/177828

Hau151978 · 6/9/15

Nếu số dòng và cột cố định, dữ liệu từ E4 đến DB966748 thì code chạy khoảng 30s. Bạn có thể thay giá trị k bằng số khác nhưng không là ước số của 966745 cộng 1.

Mã:

Option Explicit
Const Cot = 102
Const Dong = 966748
Const k = 20000
Dim Arr()
Dim ArrNoData(), ArrData()


Sub xyz(ByVal FirstRow&, ByVal LastRow&)
    Dim n&, i&, j&, MaxData&, MaxNoData&, CurrentData&, CurrentNoData&
    Arr = Range("E" & FirstRow, "DB" & LastRow).Value2
    n = LastRow - FirstRow + 1
    For i = 1 To n
        MaxData = 0
        MaxNoData = 0
        CurrentData = 0
        CurrentNoData = 0
        For j = 1 To Cot
            If Arr(i, j) > 0 Then
                If CurrentNoData > MaxNoData Then MaxNoData = CurrentNoData
                CurrentNoData = 0
                CurrentData = CurrentData + 1
            Else
                If CurrentData > MaxData Then MaxData = CurrentData
                CurrentData = 0
                CurrentNoData = CurrentNoData + 1
            End If
        Next
        If MaxData = 0 Then MaxData = CurrentData
        If MaxNoData = 0 Then MaxNoData = CurrentNoData
        ArrNoData(i, 1) = MaxNoData
        ArrData(i, 1) = MaxData
    Next
    Range("B" & FirstRow, "B" & LastRow) = ArrNoData
    Range("D" & FirstRow, "D" & LastRow) = ArrData
End Sub
Sub xxx()
    Dim i&, t
    Application.ScreenUpdating = False
    t = Timer
    i = 4
    ReDim ArrNoData(1 To k, 1 To 1)
    ReDim ArrData(1 To k, 1 To 1)
    Do
        If i + k - 1 > Dong Then
            xyz i, Dong
            GoTo Thoat
        End If
        xyz i, i + k - 1
        i = i + k
    Loop
Thoat:
    Application.ScreenUpdating = True
    MsgBox Timer - t
End Sub

hcl_pt · 6/9/15

Hau151978 đã viết:

Nếu số dòng và cột cố định, dữ liệu từ E4 đến DB966748 thì code chạy khoảng 30s. Bạn có thể thay giá trị k bằng số khác nhưng không là ước số của 966745.

Mã:

Option Explicit
Const Cot = 102
Const Dong = 966748
Const k = 20000
Dim Arr()
Dim ArrNoData(), ArrData()


Sub xyz(ByVal FirstRow&, ByVal LastRow&)
    Dim n&, i&, j&, MaxData&, MaxNoData&, CurrentData&, CurrentNoData&
    Arr = Range("E" & FirstRow, "DB" & LastRow).Value2
    n = LastRow - FirstRow + 1
    For i = 1 To n
        MaxData = 0
        MaxNoData = 0
        CurrentData = 0
        CurrentNoData = 0
        For j = 1 To Cot
            If Arr(i, j) > 0 Then
                If CurrentNoData > MaxNoData Then MaxNoData = CurrentNoData
                CurrentNoData = 0
                CurrentData = CurrentData + 1
            Else
                If CurrentData > MaxData Then MaxData = CurrentData
                CurrentData = 0
                CurrentNoData = CurrentNoData + 1
            End If
        Next
        If MaxData = 0 Then MaxData = CurrentData
        If MaxNoData = 0 Then MaxNoData = CurrentNoData
        ArrNoData(i, 1) = MaxNoData
        ArrData(i, 1) = MaxData
    Next
    Range("B" & FirstRow, "B" & LastRow) = ArrNoData
    Range("D" & FirstRow, "D" & LastRow) = ArrData
End Sub
Sub xxx()
    Dim i&, t
    Application.ScreenUpdating = False
    t = Timer
    i = 4
    ReDim ArrNoData(1 To k, 1 To 1)
    ReDim ArrData(1 To k, 1 To 1)
    Do
        If i + k - 1 > Dong Then
            xyz i, Dong
            GoTo Thoat
        End If
        xyz i, i + k - 1
        i = i + k
    Loop
Thoat:
    Application.ScreenUpdating = True
    MsgBox Timer - t
End Sub

Cảm ơn bạn! Bạn ơi mình chạy thử thì kết quả nhiều dòng không chính xác mong bạn xem giúp:
- Nhiều dòng có kết quả số cột liên tiếp nhiều nhất không có dữ liệu còn lớn hơn so với số cột liên tiếp nhiều nhất không có dữ liệu ở trong dòng thực tế.
Ví dụ: thực tế dòng có số cột liên tiếp nhiều nhất không có dữ liệu chỉ có là 4 cột, nhưng khi chạy code thì lại cho kết quả là số cột liên tiếp nhiều nhất không có dữ liệu lại là 6?
Nhưng đúng là Thời gian xử lí tuyệt bạn ạ, rất nhanh. Xin cảm ơn bạn!

Hau151978 · 7/9/15

Mình nghĩ có thể có ô nào đó có dấu cách hoặc ký tự đặc biệt nên kết quả sai. Số 0 coi như không có dữ liệu. Bạn thử tìm xem hoặc upload dòng bị sai lên xem.

hcl_pt · 7/9/15

Hau151978 đã viết:
Mình nghĩ có thể có ô nào đó có dấu cách hoặc ký tự đặc biệt nên kết quả sai. Số 0 coi như không có dữ liệu. Bạn thử tìm xem hoặc upload dòng bị sai lên xem.

Vâng, cảm ơn bạn! File dữ liệu của mình vẫn nhập số 0, nên số 0 vẫn coi là dữ liệu ạ!

doveandrose · 7/9/15

hcl_pt đã viết:
Dạ, mình đang làm file minh hoạ để gửi lên ạ. Cảm ơn bạn!
Mong bạn và GPE xem giúp trường hợp ngược lại là tìm số ngày liên tiếp nhiều nhất không có chứa dữ liệu với file thực tế là lên 966748 dòng ạ! Xin cảm ơn GPE rất nhiều!

bạn lấy code bài #15 về chạy là được mà

tìm trong đó có dòng

Mã:

[COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) [/FONT][/COLOR][COLOR=#ff0000][FONT=monospace][SIZE=4][B]<>[/B][/SIZE][/FONT][/COLOR][COLOR=#007700][FONT=monospace] Empty [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then[/FONT][/COLOR]

thay bằng

Mã:

[COLOR=#007700][FONT=monospace]If [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]sArr[/FONT][/COLOR][COLOR=#007700][FONT=monospace]([/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]I[/FONT][/COLOR][COLOR=#007700][FONT=monospace], [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]J[/FONT][/COLOR][COLOR=#007700][FONT=monospace]) [/FONT][/COLOR][COLOR=#ff0000][FONT=monospace][SIZE=4][B]=[/B][/SIZE][/FONT][/COLOR][COLOR=#007700][FONT=monospace] Empty [/FONT][/COLOR][COLOR=#0000BB][FONT=monospace]Then[/FONT][/COLOR]

hcl_pt · 24/9/15

Ba Tê đã viết:
Không nhớ ngày xưa cân ra sao, bây giờ thì dễ rồi, xẻ con voi thành từng mảnh, nhặt từng mảnh cân, xong rồi cộng lại...
Cuối cùng là "đi tự thú". Híc!
Xẻ thịt cho bài #2, thời gian "Gom,Cân" khoảng 22" cho dữ liệu đến dòng 966748

PHP:

Public Sub GPE() Application.ScreenUpdating = False Dim I As Long, J As Long, N As Long, Num As Long, MaxNum As Long, K As Long Dim sArr(), dArr(1 To 1000000, 1 To 1), eRws As Long, Rw As Long eRws = [E4].End(xlDown).Row For N = 4 To eRws Step 10000 Rw = IIf((N + 9999) > eRws, eRws - N + 1, 10000) sArr = Range("G" & N).Resize(Rw, 101).Value For I = 1 To Rw K = K + 1 Num = 0: MaxNum = 0 For J = 1 To 101 If sArr(I, J) <> Empty Then Num = Num + 1 If MaxNum < Num Then MaxNum = Num Else Num = 0 End If Next J dArr(K, 1) = MaxNum Next I Next N Range("D4").Resize(K) = dArr End Sub

Thầy Ba Tê ơi, trong đoạn code này khi em chạy thì những ô có chứa dữ liệu là 0 thì lại không đếm ạ, ở đây những ô chứa giá trị 0 vẫn coi là có dữ liệu Thầy ạ! Mong Thầy xem giúp cho em với ạ! Xin cảm ơn Thầy và GPE rất nhiều! Chúc GPE một ngày mới thành công!

Tìm số cột liên tiếp nhiều nhất có chứa dữ liệu

SA_DQ

/(hông là gì!

hcl_pt

Thành viên thường trực

SA_DQ

/(hông là gì!

Hau151978

Thành viên tích cực

hcl_pt

Thành viên thường trực

Hau151978

Thành viên tích cực

hcl_pt

Thành viên thường trực

doveandrose

hello

hcl_pt

Thành viên thường trực

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

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