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Ố Ô LIÊN TIẾP NHIỀU NHẤT CÓ DỮ LIỆU MÀ ĐỨNG TRƯỚC NÓ LÀ CÓ ÍT NHẤT 1 Ô TRỐNG KHÔNG 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!
tìm SỐ Ô LIÊN TIẾP NHIỀU NHẤT CÓ DỮ LIỆU TRONG DÒNG (1 người xem)
- Thread starter pt_hcl
- Ngày gửi
Người dùng đang xem chủ đề này
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
nếu số liệu lớn thì phải xài vba, tôi thấy dạng này trên diễn đàn cũng nhiêu
với file hiện tại thì thử cthuc này
Mã:
D4=LARGE(FREQUENCY(IF(G4:DB4<>"",COLUMN(G4:DB4)-6),IF(G4:DB4="",COLUMN(G4:DB4)-6)),IF(G4="",1,2))nhấn Ctrl shift enter để kết thúc
mhung12005
Thành viên chậm chạm
- Tham gia
- 20/7/11
- Bài viết
- 1,598
- Được thích
- 1,261
- Nghề nghiệp
- Đâu có việc thì làm
Với dữ liệu: "File thực tế có vùng dữ liệu rất lớn: (D4: DB966748)" 100 cột 966748 nghìn dòng thì không công thức nào chịu nổi đâu bạn. Tốt nhất là dùng VBA thôi.
Vâng ạ, cảm ơn thầy rất nhiều! Nếu thầy giúp được VBA thì hay quá!
Phuocam
Thành viên mới
- Tham gia
- 16/5/13
- Bài viết
- 4,776
- Được thích
- 7,806
Không dễ ăn đâu bạn hiền ơi, thử nhập 1 số vào G4 sẽ thấy công thức "tèo"
vâng, rất mong thầy và các bạn trong GPE giúp đỡ về VBA ạ!
doveandrose
hello
- Tham gia
- 3/7/09
- Bài viết
- 2,372
- Được thích
- 2,263
VBA thì càng không cần phải lo . đã có Let' Gâu Gâu bảo kê hết
Vâng ạ! Mà em xin lỗi một chút ạ, trong file thì ô có chứa số 0 vẫn tính là có dữ liệu ạ, trong file minh hoạ em chưa có trường hợp này! Rất mong sự giúp đỡ của GPE!
Lần chỉnh sửa cuối:
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
trong khi đợi cao thủ ra tay, xem thử
à quên, đừng kêu bằng thầy, tôi không thể đạt được đẳng cấp đó
==========
chỉ là múa rìu qua mắt thợ thui........chơi vui cho qua ngày đoạn tháng mà.......hehehehehh
doveandrose
hello
- Tham gia
- 3/7/09
- Bài viết
- 2,372
- Được thích
- 2,263
trùi ui thầy khiêm tốn quá . cách làm của thầy rất hay ạ . em học hỏi được rất nhiều từ thầy ạ . hi hi hi
Phuocam
Thành viên mới
- Tham gia
- 16/5/13
- Bài viết
- 4,776
- Được thích
- 7,806
Ké theo 1 hàm, giải trí chơi:
Mã:
Public Function LienTiep(Vung As Range) As Long
Dim i As Long, Tam As Long, HeSo As Byte
For i = 1 To Vung.Columns.Count
If Vung(i).Value <> "" Then
Tam = Tam + 1
If LienTiep < Tam * HeSo Then LienTiep = Tam
Else
Tam = 0
HeSo = 1
End If
Next
End FunctionLet'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
trùi ui thầy khiêm tốn quá . cách làm của thầy rất hay ạ . em học hỏi được rất nhiều từ thầy ạ . hi hi hi
đừng chơi quê nha...............quê là khó "quề" đó.....hihihiih
==========
hỏi cái nì một tí
"Chim Hạc & Hồng Hoa" có cách nào làm cho các vòng lặp chỉ chạy một lần ko
tức là như vậy, hiện nay mỗi dòng phải xài một vòng lặp
bi giờ tôi muốn nó chỉ chạy một lần thôi
quét qua từng dòng, rồi quét từ trên xuống
công thức từ B4:B13 thì dùng dạng mảng hay sao đó
có thấy sư phụ HYen làm một lần, mà quên mất, kiếm lại cũng ko ra............hichic
doveandrose
hello
- Tham gia
- 3/7/09
- Bài viết
- 2,372
- Được thích
- 2,263
cứ yên tâm là dữ liệu bài này xài ít nhất 2 vòng lặp nếu là viết SUB (dữ liệu mà 1 000 000 dòng thì phải dùng 3 vòng )
anh cứ chuẩn bị tinh thần người ta sắp la làng lên là function chạy không nổi đi nha . hí hí
em đang để đầu óc đi ĐÚ với thầy ĐU bên topic tập giải nén file xlsx nên chưa coi kỹ được bài này . nhờ anh vậy
Vậy là file đính kèm khác file thực?
Bài này 1 vòng lặp vẫn được, thời gian hơi bị lâu ~ 300s
mhung12005
Thành viên chậm chạm
- Tham gia
- 20/7/11
- Bài viết
- 1,598
- Được thích
- 1,261
- Nghề nghiệp
- Đâu có việc thì làm
Bạn thử với đoạn code này xem.
Do file nặng quá nên mình chỉ upload code lên thôi. Mình đã thử với 1012503 dòng và 100 cột (với dữ liệu giống của bạn) mất khoảng 40s.
Mã:
Option Explicit
Declare Function GetTickCount Lib "kernel32" () As Long
Sub test()
Dim rngNguon As Range, rngDong As Range
Dim lngRNguon As Long
Dim arrKetQua(), t As Double
t = GetTickCount
Set rngNguon = Sheet1.Range("G4:DB1012503")
ReDim arrKetQua(1 To rngNguon.Rows.Count, 1 To 1)
For lngRNguon = 1 To rngNguon.Rows.Count
Set rngDong = Sheet1.Range("G" & lngRNguon + 3 & ":DB" & lngRNguon + 3)
arrKetQua(lngRNguon, 1) = DemFREQUENCY(rngDong)
Next lngRNguon
Sheet1.Range("D4").Resize(lngRNguon - 1, 1).Value = arrKetQua
MsgBox GetTickCount - t
End Sub
Function DemFREQUENCY(rngRng As Range) As Long
Dim arrNguon()
Dim lngCNguon As Long, lngDemPT As Long
arrNguon = rngRng.Value2
For lngCNguon = 1 To UBound(arrNguon, 2)
If Len((arrNguon(1, lngCNguon))) Then
lngDemPT = lngDemPT + 1
If DemFREQUENCY < lngDemPT Then DemFREQUENCY = lngDemPT
Else
lngDemPT = 0
End If
Next lngCNguon
End FunctionVâng cảm ơn bạn! Bạn ơi mong bạn xem giúp lại một chút chỗ điều kiện là số ô có dữ liệu liên tiếp nhiều nhất mà trước đó phải có ô trống ạ! Một lần nữa xin cảm ơn bạn và GPE!
doveandrose
hello
- Tham gia
- 3/7/09
- Bài viết
- 2,372
- Được thích
- 2,263
tất cả những người ở trên đều viết theo ý tưởng màu đỏ . cho nên nếu bạn cảm thấy sai thì bạn up file khác lên đây và chỉ rõ đã sai ở dòng nào ? và dòng đó phải là bao nhiêu mới đúng ? giải thích lý do .
Dạ vâng, em chạy thử với code của bài #15 thì kết quả đếm số ô nhiều nhất là không có ô trống ban đầu ạ! Em xin gửi file minh hoạ! Xin cảm ơn GPE!
doveandrose
hello
- Tham gia
- 3/7/09
- Bài viết
- 2,372
- Được thích
- 2,263
Mã:
Public Sub hello()
Dim lr As Long, lc As Long, arr As Variant, r As Long, dArr As Variant, tCount As Double, validSpace As Boolean
Dim c As Long, maxCount As Long, tempCount As Long, tempUbound As Long, curRow As Long, k As Long, uc As Long
tCount = Timer
Application.ScreenUpdating = False
With Sheet1
lr = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
lc = .UsedRange.SpecialCells(xlCellTypeLastCell).Column - 6
ReDim dArr(1 To .Rows.Count, 1 To 1)
curRow = 4
Do While tempUbound < lr
tempUbound = tempUbound + 50000
arr = .Range("G" & curRow & ":G" & WorksheetFunction.Min(tempUbound, lr)).Resize(, lc).Value
uc = UBound(arr, 2)
For r = 1 To UBound(arr) Step 1
maxCount = 0: tempCount = 0: validSpace = False
For c = 1 To uc Step 1
If Not arr(r, c) = Empty Then
If validSpace Then tempCount = tempCount + 1
Else
If tempCount > maxCount Then maxCount = tempCount
tempCount = 0: validSpace = True
End If
Next
k = k + 1
dArr(k, 1) = maxCount
Next
curRow = curRow + UBound(arr)
Loop
.Range("D4").Resize(k).Value = dArr
End With
Application.ScreenUpdating = True
MsgBox Timer - tCount
End Sub
Lần chỉnh sửa cuối:
Vâng cảm ơn bạn, bạn ơi những ô có chứa dữ liệu là số 0 thì vẫn được tính ạ, trong code của bạn mình chạy thì không đếm dữ liệu là số 0. Bạn xem giúp ạ! Xin cảm ơn bạn1
doveandrose
hello
- Tham gia
- 3/7/09
- Bài viết
- 2,372
- Được thích
- 2,263
hãy up file lên để chứng minh điều bạn nói
Mã:
[COLOR=#000000]If Not arr(r, c) = Empty Then[/COLOR]sửa thành
Mã:
If Len(arr(r, c)) > 0 Then
Lần chỉnh sửa cuối:
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
code bí hiểm như người vậy............hihihihi
mà sao lại phải xài tới 3 vòng lặp lận
giải thích tí cho anh em được mở mang với
(vòng lặp while làm gì vậy?)
============
à hiểu sơ sơ rồi,chắc là để xác định vùng arr từ dòng hiện tại tới cuối bảng
Lần chỉnh sửa cuối:
doveandrose
hello
- Tham gia
- 3/7/09
- Bài viết
- 2,372
- Được thích
- 2,263
không đơn giản vậy đâu bồ ơi
khi mảng mà đòi nhét dữ liệu lớn quá là nó bị OVER FLOW liền . dữ liệu lên hàng triệu dòng thì ta chỉ có cách chặt ra lấy từng 50 000 dòng ra đọc thôi .
Vâng, cảm ơn bạn rất rất nhiều! Chính xác rồi bạn ạ.
Mình xin hỏi thêm một chút: code này chỉ chạy với sheet1, nhưng muốn chạy với sheet khác thì mình làm thế nào ạ? Xin cảm ơn bạn!
Bạn xem kết quả dòng 13 chính xác không ạ!
Cảm ơn bạn, kết quả ở dòng 13 phải là 99 ạ! Mặt khác nếu ô có dữ liệu là số 0 thì vẫn được tính ạ, trong code của bạn không đếm ô dữ liệu có chứa số 0. Rất mong bạn xem lại giúp!
huuthang_bd
Chuyên gia GPE
- Tham gia
- 10/9/08
- Bài viết
- 8,933
- Được thích
- 11,353
- Donate (Momo)
- Giới tính
- Nam
- Nghề nghiệp
- Thợ đụng
Thử vầy xem
PHP:
Sub HôAndLé()
Const StartR As Long = 4, StartC As Long = 7
Dim EndR As Long, EndC As Long, Cols As Long, i As Long, j As Long, jStart As Long, ArrData, ArrResult() As Long, iResult As Long, Status As Boolean
EndR = Cells(&H100000, StartC - 1).End(xlUp).Row
EndC = Cells(StartR - 1, &H4000).End(xlToLeft).Column
If EndR < StartR Or EndC < StartC Then Exit Sub
ArrData = Range(Cells(StartR, StartC), Cells(EndR, EndC)).Value
ReDim ArrResult(1 To UBound(ArrData, 1), 1 To 1)
Cols = EndC - StartC + 1
For i = 1 To UBound(ArrData, 1)
For j = 1 To Cols
If Len(ArrData(i, j)) = 0 Then GoTo HasBlank
Next
GoTo Next_i
HasBlank:
Status = False: jStart = j: iResult = 0
Do: Do
j = j + 1
If j > Cols Then Exit Do
Loop Until (Len(ArrData(i, j)) > 0) Xor Status
If Status And j - jStart > iResult Then iResult = j - jStart
Status = Not Status: jStart = j
Loop Until j > Cols
ArrResult(i, 1) = iResult
Next_i:
Next
Range("D4:D" & EndR).Value = ArrResult
End Sub
Lần chỉnh sửa cuối:
Cảm ơn bạn nhiều quá, chuẩn không cần chỉnh ạ! Cảm ơn GPE!
- Bạn ơi cho mình hỏi trong code của bạn chỗ nào yêu cầu thực hiện vẫn tính ô có dữ liệu là số 0 ạ? Vì mình thấy trong code khác của các bạn cứ ô có dữ liệu là số 0 thì lại không đếm? Mong bạn chỉ giúp! Cảm ơn bạn!
Tham khảo 1 đoạn code. Thời gian chạy cho 1000000 dòng khoảng 300s
Xem chơi chứ dữ liệu lớn thế này chắc không dùng được
Dữ liệu trong 1 ô nếu có chỉ là 1 số
Chèn thêm sheet2 rồi chạy
Mã:
Public Sub LienTuc()
Dim reg As Object, kq(), Dong, r As Long, tg
tg = Timer
On Error Resume Next
Dong = Sheet1.UsedRange.Rows.Count
ReDim kq(1 To Dong, 1 To 1)
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
reg.Pattern = "(\d)\s"
With CreateObject("MSScriptControl.ScriptControl")
.Language = "JavaScript"
For r = 4 To Dong
kq(r, 1) = Join(Application.Transpose(Application.Transpose(Sheet1.Range("G" & r, "DB" & r))))
kq(r, 1) = reg.Replace(kq(r, 1), "$1")
kq(r, 1) = Split(kq(r, 1), " ")
kq(r, 1)(0) = ""
kq(r, 1) = Application.Trim(Join(kq(r, 1), " "))
kq(r, 1) = .Eval("('" & kq(r, 1) & "').split(' ').sort(function (a, b) { return a - b; }).reverse()")
kq(r, 1) = Len(Split(kq(r, 1), ",")(0))
Next r
End With
With Sheet2
.UsedRange.Clear
.Range("A1").Resize(UBound(kq), 1) = kq
.Range("A1") = Timer - tg
End With
End SubBài viết mới nhất
- Question
- Question
Nhờ các anh chị sửa dùm công thức ạ.
(1 người xem)
- Question
Lỗi "User-defined type not defined" khi khai báo biến
(2 người xem)
- Dán lên cao
- Suggestion
