Tìm số cột liên tiếp nhiều nhất có chứa dữ liệu (1 người xem)

  • Thread starter Thread starter hcl_pt
  • Ngày gửi Ngày gửi
Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
H

hcl_pt

Thành viên thường trực
Tham gia
21/10/10
Bài viết
208
Được thích
11
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!
 

File đính kèm

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!
Nhấp chuột vào đây để mở rộng...

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
 
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!
Nhấp chuột vào đây để mở rộng...

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

 
Lần chỉnh sửa cuối:
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.
 
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.
Nhấp chuột vào đây để mở rộng...
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!
 
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!
Nhấp chuột vào đây để mở rộng...
Đề 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-/.
 
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]
 
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]
Nhấp chuột vào đây để mở rộng...
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!)
 
đâ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
 
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!)
Nhấp chuột vào đây để mở rộng...

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é!
 
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
Nhấp chuột vào đây để mở rộng...
Vâng cảm ơn bạn nhiều ạ! Khi mình chạy với file có vùng dữ liệu(D4:DB966748) 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!
 
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(D4:DB966748) 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!
Nhấp chuột vào đây để mở rộng...

ở 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

a9ee39eda51b2e76da2be84a2d124aaf.png



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
 
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é!
Nhấp chuột vào đây để mở rộng...

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
 
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
Nhấp chuột vào đây để mở rộng...

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
 
Lần chỉnh sửa cuối:
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
Nhấp chuột vào đây để mở rộng...

đ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
Nhấp chuột vào đây để mở rộng...
vâng bác ấy rất tỉnh . hi hi
 
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!
Nhấp chuột vào đây để mở rộng...
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 ?
 
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 ?
Nhấp chuột vào đây để mở rộng...
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!
 

File đính kèm

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

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
 
HYen17 đã viết:
Bạn có thể xài hàm này vô ô [B4]; Cú fáp: =MaxBlankCells(E4:DB4)

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
Nhấp chuột vào đây để mở rộng...
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!
 
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!
Nhấp chuột vào đây để mở rộng...

* 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
 
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
Nhấp chuột vào đây để mở rộng...
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!
 
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
 
Lần chỉnh sửa cuối:
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
Nhấp chuột vào đây để mở rộng...
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!
 
Lần chỉnh sửa cuối:
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.
 
Lần chỉnh sửa cuối:
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.
Nhấp chuột vào đây để mở rộng...
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 ạ!
 
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!
Nhấp chuột vào đây để mở rộng...
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]
 
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
Nhấp chuột vào đây để mở rộng...
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!
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản."
    • Thích
    • Yêu thích
Trả lời
5
Đọc
1K
longlacda
L
V
Công thức để phân công chuyên môn cho giáo viên (1 người xem)
Trả lời
5
Đọc
258
vietvanyen
V
E
Đánh số cho các cặp số chứng từ và số chứng từ đối ứng
Trả lời
12
Đọc
227
Phan Thế Hiệp
Phan Thế Hiệp
G
AddIn convert ngày dương lịch sang âm lịch và ngược lại + đọc ngày tháng
Trả lời
20
Đọc
10K
du trung kien
D
8
Hàm trong excel
Trả lời
3
Đọc
60
Hoàng Tuấn 868
H
N
Chuyển giờ công từ bảng công vào bảng tính (1 người xem)
Trả lời
16
Đọc
290
ngouyen1505
N
N
Tạo COM Add-In bằng Visual C++
    • Thích
Trả lời
7
Đọc
656
nguyendang95
N
T
Tìm số hóa đơn trong chuỗi
Trả lời
8
Đọc
353
tranhungdao12a3
T
Nga1852k
lỗi excel không chèn được dòng và không xóa được dòng (1 người xem)
Trả lời
2
Đọc
134
Nga1852k
Nga1852k
D
  • Question Question
xin các cao thủ trợ giúp , hoặc nhận làm code có trả phí ạ
Trả lời
14
Đọc
1K
tung1423
tung1423
D
xin hỏi về lỗi mô đun ẩn. (1 người xem)
Trả lời
3
Đọc
144
ongke0711
ongke0711
H
Xin anh chị hướng dẫn công thức excel ạ.
Trả lời
9
Đọc
287
Phan Thế Hiệp
Phan Thế Hiệp
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
381
Đọc
44K
tuanktt3
T
M
Add-in Excel kết nối cơ sở dữ liệu (2 người xem)
Trả lời
1
Đọc
110
ptm0412
ptm0412
Đ
tách dữ liệu từ một dòng thành hai dòng
Trả lời
2
Đọc
152
Phuocam
Phuocam
longhuy
Lỗi error 20728: F
Trả lời
0
Đọc
76
longhuy
longhuy
H
Trang tính chỉ hiển thị vùng có dữ liệu
Trả lời
7
Đọc
606
vinhkm6
vinhkm6
mrjun80
Có hàm nào đếm tổng các số nằm trong 1 ô không mọi người
Trả lời
12
Đọc
498
Phan Thế Hiệp
Phan Thế Hiệp
N
Hàm DATEDIF trong Excel 2016
Trả lời
16
Đọc
14K
Phan Thế Hiệp
Phan Thế Hiệp
Tiger Nau
Đánh số thứ tự trên tờ vé số
Trả lời
6
Đọc
186
ptm0412
ptm0412
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom