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

hcl_pt · 4/9/15

Mong GPE giúp đỡ mình trường hợp này, mình có bảng dữ liệu cần tìm SỐ CỘT LIÊN TIẾP NHIỀU NHẤT CÓ DỮ LIỆU đối với từng dòng. Mình có gửi file minh hoạ. Kết quả đếm số cột liên tiếp có dữ liệu nhiều nhất được ghi vào cột 4. File thực tế có vùng dữ liệu rất lớn: (D4: DB966748). Rất mong GPE giúp đỡ. Xin cảm ơn!

Ba Tê · 4/9/15

hcl_pt đã viết:
Mong GPE giúp đỡ mình trường hợp này, mình có bảng dữ liệu cần tìm SỐ CỘT LIÊN TIẾP NHIỀU NHẤT CÓ DỮ LIỆU đối với từng dòng. Mình có gửi file minh hoạ. Kết quả đếm số cột liên tiếp có dữ liệu nhiều nhất được ghi vào cột 4. File thực tế có vùng dữ liệu rất lớn: (D4: DB966748). Rất mong GPE giúp đỡ. Xin cảm ơn!

Chạy thử Sub này:

PHP:

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, Num As Long, MaxNum As Long
sArr = Range([F4], [F4].End(xlDown)).Offset(, 1).Resize(, 101).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
For I = 1 To UBound(sArr, 1)
    Num = 0: MaxNum = 0
    For J = 1 To UBound(sArr, 2)
        If sArr(I, J) <> Empty Then
            Num = Num + 1
            If MaxNum < Num Then MaxNum = Num
        Else
            Num = 0
        End If
    Next J
    dArr(I, 1) = MaxNum
Next I
[D4].Resize(I - 1) = dArr
End Sub

phulien1902 · 4/9/15

hcl_pt đã viết:
Mong GPE giúp đỡ mình trường hợp này, mình có bảng dữ liệu cần tìm SỐ CỘT LIÊN TIẾP NHIỀU NHẤT CÓ DỮ LIỆU đối với từng dòng. Mình có gửi file minh hoạ. Kết quả đếm số cột liên tiếp có dữ liệu nhiều nhất được ghi vào cột 4. File thực tế có vùng dữ liệu rất lớn: (D4: DB966748). Rất mong GPE giúp đỡ. Xin cảm ơn!

Bạn dùng công thức sau cho D4

PHP:

D4=MAX(FREQUENCY(IF(G4:DB4<>"",COLUMN(G4:DB4)),IF(G4:DB4="",COLUMN(G4:DB4))))

Nhớ bấm đồng thời 3 phím: Ctrl + Shift + Enter

leonguyenz · 4/9/15

Gần 1 triệu dòng, công thức mảng chừng nào mới tính toán xong?
Sử dụng hàm tự tạo sẽ linh động hơn:

Mã:

Public Function GpeTest(Rng As Range) As Integer
Dim sArr(), iR As Integer, Tmp As Integer, Numax As Integer
sArr = Rng.Value
For iR = LBound(sArr, 2) To UBound(sArr, 2)
    If sArr(1, iR) > 0 Then
        Tmp = Tmp + 1
        If Numax < Tmp Then Numax = Tmp
    Else
        Tmp = 0
    End If
Next iR
GpeTest = Numax
End Function

Code áp dụng cho bài này thôi.

Hoàng Trọng Nghĩa · 4/9/15

leonguyenz đã viết:
Gần 1 triệu dòng, công thức mảng chừng nào mới tính toán xong?
Sử dụng hàm tự tạo sẽ linh động hơn:

Mã:

Public Function GpeTest(Rng As Range) As Integer Dim sArr(), iR As Integer, Tmp As Integer, Numax As Integer sArr = Rng.Value For iR = LBound(sArr, 2) To UBound(sArr, 2) If sArr(1, iR) > 0 Then Tmp = Tmp + 1 If Numax < Tmp Then Numax = Tmp Else Tmp = 0 End If Next iR GpeTest = Numax End Function

Code áp dụng cho bài này thôi.

Chỉ là hỏi chơi thôi nha, nếu người ta ghi vầy thì sao: =GpeTest(Range("A1"))

Tức là chỉ chọn 1 ô thì sao nhỉ? Chính nó cũng là Max phố hôn? Kết quả?

p/s: Chỉ trong một thời gian ngắn mà tiến bộ ghê ta!

leonguyenz · 4/9/15

Hoàng Trọng Nghĩa đã viết:
Chỉ là hỏi chơi thôi nha, nếu người ta ghi vầy thì sao: =GpeTest(Range("A1"))

Tức là chỉ chọn 1 ô thì sao nhỉ? Chính nó cũng là Max phố hôn? Kết quả?

p/s: Chỉ trong một thời gian ngắn mà tiến bộ ghê ta!

Đề bài là tìm số cột liên tiếp nên em mới ghi cái dòng cuối, anh "hỏi chơi" khó thế -0-/.

ChanhTQ@ · 4/9/15

Nên xài macro để nạp hàm tự tạo:

PHP:

Sub GPE_()
 Dim Arr()
 Dim J As Long, Tmr#
  
 Tmr = Timer()
 Arr = Range([F4], [F4].End(xlDown)).Offset(, 1).Resize(, 101).Value
 ReDim dArr(1 To UBound(Arr, 1), 1 To 1)
 For J = 1 To UBound(Arr())
    dArr(J, 1) = MaxValue(Cells(J + 3, "G").Resize(, 102))
 Next J
 [d4].Resize(J - 1).Value = dArr()
 [e2].Value = Timer() - Tmr
End Sub

Mã:

[B]Function MaxValue(GPE As Range)
[/B] Dim tArr()
 Dim J As Long, Num As Integer, Max_ As Integer
 
 tArr() = GPE.Value
 For J = 1 To UBound(tArr(), 2)
    If tArr(1, J) <> "" Then
        Num = 1 + Num
        If Max_ < Num Then Max_ = Num
    Else
        Num = 0
    End If
 Next J
 MaxValue = Max_
[B]End Function
[/B]

hcl_pt · 4/9/15

ChanhTQ@ đã viết:

Nên xài macro để nạp hàm tự tạo:

PHP:

Sub GPE_()
 Dim Arr()
 Dim J As Long, Tmr#
  
 Tmr = Timer()
 Arr = Range([F4], [F4].End(xlDown)).Offset(, 1).Resize(, 101).Value
 ReDim dArr(1 To UBound(Arr, 1), 1 To 1)
 For J = 1 To UBound(Arr())
    dArr(J, 1) = MaxValue(Cells(J + 3, "G").Resize(, 102))
 Next J
 [d4].Resize(J - 1).Value = dArr()
 [e2].Value = Timer() - Tmr
End Sub

Mã:

[B]Function MaxValue(GPE As Range)
[/B] Dim tArr()
 Dim J As Long, Num As Integer, Max_ As Integer
 
 tArr() = GPE.Value
 For J = 1 To UBound(tArr(), 2)
    If tArr(1, J) <> "" Then
        Num = 1 + Num
        If Max_ < Num Then Max_ = Num
    Else
        Num = 0
    End If
 Next J
 MaxValue = Max_
[B]End Function
[/B]

Bác ChanhTQ ơi, em chạy thì báo OUT OF MEMORY và báo vàng "Arr = Range([F4], [F4].End(xlDown)).Offset(, 1).Resize(, 101).Value". Vậy có cách nào giải quyết được vấn đề này không ạ? Xin cảm ơn bác!
(Xin phép bác, cho em ké chút ạ: em chạy của bác BaTe cũng báo như vậy ạ! Mong bác cũng xem giúp ạ! Chân thành cảm ơn các bác và GPE!)

doveandrose · 4/9/15

đây là sub chạy không thấy bị OUT OF MEMORY trên máy tôi , bạn thử xem

Mã:

Public Sub hello()
Dim lr As Long, lc As Long, arr As Variant, r As Long, ub As Long, dArr As Variant
Dim c As Long, maxCount As Long, tempCount As Long, uc As Long, tempUbound As Long, curRow As Long
Application.ScreenUpdating = False
With Sheet1
    lr = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
    lc = .UsedRange.SpecialCells(xlCellTypeLastCell).Column - 6
    curRow = 4
    Do While tempUbound < lr
        tempUbound = tempUbound + 100000
        arr = .Range("G" & curRow & ":G" & WorksheetFunction.Min(tempUbound, lr)).Resize(, lc).Value
        ub = UBound(arr): uc = UBound(arr, 2)
        ReDim dArr(1 To ub, 1 To 1)
        For r = 1 To ub Step 1
            maxCount = 0: tempCount = 0
            For c = 1 To uc Step 1
                If Not arr(r, c) = Empty Then
                    tempCount = tempCount + 1
                Else
                    If tempCount > maxCount Then maxCount = tempCount
                    tempCount = 0
                End If
            Next
            dArr(r, 1) = maxCount
        Next
        .Range("D" & curRow).Resize(ub).Value = dArr
        curRow = curRow + ub
    Loop
End With
Application.ScreenUpdating = True
End Sub

phulien1902 · 4/9/15

hcl_pt đã viết:
Bác ChanhTQ ơi, em chạy thì báo OUT OF MEMORY và báo vàng "Arr = Range([F4], [F4].End(xlDown)).Offset(, 1).Resize(, 101).Value". Vậy có cách nào giải quyết được vấn đề này không ạ? Xin cảm ơn bác!
(Xin phép bác, cho em ké chút ạ: em chạy của bác BaTe cũng báo như vậy ạ! Mong bác cũng xem giúp ạ! Chân thành cảm ơn các bác và GPE!)

Xin thưa với bạn là tất cả các Code trên đều chạy tốt ở máy tôi.
Bạn thử lại xem sao nhé!

hcl_pt · 5/9/15

phulien1902 đã viết:
Xin thưa với bạn là tất cả các Code trên đều chạy tốt ở máy tôi.
Bạn thử lại xem sao nhé!

Vâng ạ, e. Chạy với file thực tế có vùng dữ liệu (D4

B966748) nên bị như vậy ạ.

hcl_pt · 5/9/15

doveandrose đã viết:

đây là sub chạy không thấy bị OUT OF MEMORY trên máy tôi , bạn thử xem

Mã:

Public Sub hello()
Dim lr As Long, lc As Long, arr As Variant, r As Long, ub As Long, dArr As Variant
Dim c As Long, maxCount As Long, tempCount As Long, uc As Long, tempUbound As Long, curRow As Long
Application.ScreenUpdating = False
With Sheet1
    lr = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
    lc = .UsedRange.SpecialCells(xlCellTypeLastCell).Column - 6
    curRow = 4
    Do While tempUbound < lr
        tempUbound = tempUbound + 100000
        arr = .Range("G" & curRow & ":G" & WorksheetFunction.Min(tempUbound, lr)).Resize(, lc).Value
        ub = UBound(arr): uc = UBound(arr, 2)
        ReDim dArr(1 To ub, 1 To 1)
        For r = 1 To ub Step 1
            maxCount = 0: tempCount = 0
            For c = 1 To uc Step 1
                If Not arr(r, c) = Empty Then
                    tempCount = tempCount + 1
                Else
                    If tempCount > maxCount Then maxCount = tempCount
                    tempCount = 0
                End If
            Next
            dArr(r, 1) = maxCount
        Next
        .Range("D" & curRow).Resize(ub).Value = dArr
        curRow = curRow + ub
    Loop
End With
Application.ScreenUpdating = True
End Sub

Vâng cảm ơn bạn nhiều ạ! Khi mình chạy với file có vùng dữ liệu(D4

B966748) thì có báo lỗi : run-time error : "object required" và báo vàng đoạn: "lr = .UsedRange.SpecialCells(xlCellTypeLastCell).Row"
Mong xem giúp!

doveandrose · 5/9/15

hcl_pt đã viết:
Vâng cảm ơn bạn nhiều ạ! Khi mình chạy với file có vùng dữ liệu(D4B966748) thì có báo lỗi : run-time error : "object required" và báo vàng đoạn: "lr = .UsedRange.SpecialCells(xlCellTypeLastCell).Row"
Mong xem giúp!

ở cửa sổ Visual Basic bạn cần nhìn xem sheet của bạn có cái tên gì . file của tôi có tên là sheet1 . đây là hình ảnh

bạn chú ý là cái tên mà tôi khoanh tròn nhé . ví dụ sheet của bạn có tên là sheet2 thì trong code mà tôi khoanh tròn bạn phải sửa lại là

Mã:

With Sheet2

với lại sau khi tôi test trên máy 32 bit vẫn bị OUT OF MEMORY nên bạn phải sửa số 100 000 thành 50 000 như phần khoanh tròn ở trên

Mã:

tempUbound = tempUbound + 50000

doveandrose · 5/9/15

phulien1902 đã viết:
Xin thưa với bạn là tất cả các Code trên đều chạy tốt ở máy tôi.
Bạn thử lại xem sao nhé!

tốt với file bao nhiêu dòng vậy bạn ? với file này còn tốt nữa không ta ? hi hi
http://www.mediafire.com/download/cu290zwjklc8hk4/SONGAYNHIEUNHAT.rar

không biết các bạn còn nhớ chuyện cổ tích dân gian về ông trạng Lương Thế Vinh đi cân voi không nhỉ ?
ông ta đã biết làm như thế cách đây mấy trăm năm rồi . giờ chúng ta học tập làm theo thôi . hi hi

Ba Tê · 5/9/15

doveandrose đã viết:
tốt với file bao nhiêu dòng vậy bạn ? với file này còn tốt nữa không ta ? hi hi
http://www.mediafire.com/download/cu290zwjklc8hk4/SONGAYNHIEUNHAT.rar

không biết các bạn còn nhớ chuyện cổ tích dân gian về ông trạng Lương Thế Vinh đi cân voi không nhỉ ?
ông ta đã biết làm như thế cách đây mấy trăm năm rồi . giờ chúng ta học tập làm theo thôi . hi hi

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

doveandrose · 5/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

đang tính hỏi thăm chỗ dArr(1 To 1000000, 1 To 1) thì bác ấy sửa lại bài viết

dữ liệu đến dòng 966748

vâng bác ấy rất tỉnh . hi hi

doveandrose · 6/9/15

hcl_pt đã viết:
Chào bạn, Cảm ơn bạn rất nhiều về bài : Tìm số cột liên tiếp nhiều nhất có chứa dữ liệu
- Mình mong bạn giúp thêm một yêu cầu ngược lại được không ạ? Vẫn file dữ liệu đó nhưng bây giờ yêu cầu là "Tìm số cột liên tiếp nhiều nhất không có chứa dữ liệu? " Rất mong sự giúp đỡ của bạn! Xin cảm ơn!

bạn muốn gì thì cứ trực tiếp gửi bài lên diễn đàn . hàng trăm ngàn người nhìn thấy có hơn là gửi thư cho chỉ 1 người nhìn thấy . cái nào lợi hơn ?

hcl_pt · 6/9/15

doveandrose đã viết:
bạn muốn gì thì cứ trực tiếp gửi bài lên diễn đàn . hàng trăm ngàn người nhìn thấy có hơn là gửi thư cho chỉ 1 người nhìn thấy . cái nào lợi hơn ?

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!

SA_DQ · 6/9/15

Bạn có thể xài hàm này vô ô [B4]; Cú fáp: =MaxBlankCells(E4B4)

PHP:

Function MaxBlankCells(GPE As Range)
 Dim tArr()
 Dim J As Long, Num As Integer, Max_ As Integer
 
 tArr() = GPE.Value
 For J = 1 To UBound(tArr(), 2)
    If tArr(1, J) = "" Then
        Num = 1 + Num
        If Max_ < Num Then Max_ = Num
    Else
        Num = 0
    End If
 Next J
 MaxBlankCells = Max_
End Function

hcl_pt · 6/9/15

HYen17 đã viết:
Bạn có thể xài hàm này vô ô [B4]; Cú fáp: =MaxBlankCells(E4B4)

PHP:

Function MaxBlankCells(GPE As Range) Dim tArr() Dim J As Long, Num As Integer, Max_ As Integer tArr() = GPE.Value For J = 1 To UBound(tArr(), 2) If tArr(1, J) = "" Then Num = 1 + Num If Max_ < Num Then Max_ = Num Else Num = 0 End If Next J MaxBlankCells = Max_ End Function

Cảm ơn 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!

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

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

File đính kèm

Cạo Rồi Khỏi Gội

GPE - My love

Thành viên gạo cội

Chuyên gia GPE

Thành viên gạo cội

0901452không62

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

hello

GPE - My love

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

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

hello

hello

Cạo Rồi Khỏi Gội

hello

hello

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

File đính kèm

/(hông là gì!

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