Code tính khoảng liền kề (1 người xem)

[qv7tb]

Em nhờ a/e forum GPE viết giúp code tính khoảng liền kê:
B1: đếm và so sánh khoảng " "liền kề đưa ra max khoảng đó trong bảng tính theo từng hàng cho ra số liệu bên cạnh.
B2: Đếm các khoảng " " liền kề cuối cùng trong bảng tính theo hàng cho ra số liệu bên cạnh.

Cảm ơn a/e forum GPE. Chúc mọi người và các thành viên GPE đón năm mới sức khỏe dồi dào, an khang thịnh vượng, GPE 2013 đón nhiều nhiều thành viên mới!

 

[Quang_Hải]

Gởi nhầm code. Đã xóa code.

 

[Quang_Hải]

Sub test()
Dim dl(), i, j, n, m, jj, x
dl = Range([A2], [A65536].End(3)).Resize(, 24).Value
For i = 1 To UBound(dl)
   For j = 22 To 1 Step -1
      If dl(i, j) <> "" Then
         For x = j To 1 Step -1
            If dl(i, x) = "" Then
               n = n + 1
            Else
               If m < n Then m = n
               n = 0
            End If
         Next
         dl(i, 23) = m
         n = 0: m = 0
         Exit For
      End If
   Next
   For j = 22 To 1 Step -1
      If dl(i, j) = "" Then
         n = n + 1
      Else
         Exit For
      End If
   Next
   dl(i, 24) = n
   n = 0
Next
[A2].Resize(i - 1, 24) = dl
End Sub

 

[nhapmon]

Em nhờ a/e forum GPE viết giúp code tính khoảng liền kê:
B1: đếm và so sánh khoảng " "liền kề đưa ra max khoảng đó trong bảng tính theo từng hàng cho ra số liệu bên cạnh.
B2: Đếm các khoảng " " liền kề cuối cùng trong bảng tính theo hàng cho ra số liệu bên cạnh.

Cảm ơn a/e forum GPE. Chúc mọi người và các thành viên GPE đón năm mới sức khỏe dồi dào, an khang thịnh vượng, GPE 2013 đón nhiều nhiều thành viên mới!

sư phụ QuangHai đã giải rồi, tôi gởi bạn xem qua cho vui, vì du sao cũng mất công làm nãy giờ....hìhi2
mình ko biết xài mảng, nên xài thức thường thôi

Sub test()

For j = 2 To 11
Count = 0
Max = 0
For i = 2 To 22
If Cells(j, i).Value = "" Then
Count = Count + 1
Else
If Max <= Count Then
Max = Count
Count = 0
k = j
l = i
Else
Count = 0
k = j
l = i

End If
End If

Range("W" & j).Value = Max
Next i
Range("x" & j).Value = Application.WorksheetFunction.CountBlank(Range(Cells(k, l), Cells(j, 22)))
Next j

End Sub

 

[qv7tb]

Sub test()
Dim dl(), i, j, n, m, jj, x
dl = Range([A2], [A65536].End(3)).Resize(, 24).Value
For i = 1 To UBound(dl)
   For j = 22 To 1 Step -1
      If dl(i, j) <> "" Then
         For x = j To 1 Step -1
            If dl(i, x) = "" Then
               n = n + 1
            Else
               If m < n Then m = n
               n = 0
            End If
         Next
         dl(i, 23) = m
         n = 0: m = 0
         Exit For
      End If
   Next
   For j = 22 To 1 Step -1
      If dl(i, j) = "" Then
         n = n + 1
      Else
         Exit For
      End If
   Next
   dl(i, 24) = n
   n = 0
Next
[A2].Resize(i - 1, 24) = dl
End Sub

Bác Hải ơi, em chạy với số lượng lớn hơn toàn bị lỗi dù đã thay dữ liệu code rồi, em kiếm trong diễn đàn mình thấy code chạy mã của bác ndu96081631 chỉ chạy max thôi, bác xem qua và cho em cái code chạy ổn định hơn với lưu lượng lớn không:
Function MaxBlank(ByVal SrcRng As Range) As Long
Dim Max As Long, Clls As Range, Chk As Boolean
For Each Clls In SrcRng
If Clls.Value <> "" Then Chk = True
If Chk Then
If IsEmpty(Clls) Then
Max = Max + 1
Else
If MaxBlank < Max Then MaxBlank = Max
Max = 0
End If
End If
Next
End Function

em sẽ gửi file với lưu lượng lớn lên ở dưới, bác coi qua cho em ý kiến. Thanks bá nhiều

 

[qv7tb]

Gửi file lớn

đây là file lớn thử nghiệm cùng với sai lệch dòng để kiểm nghiệm code. bác coi qua cho em ý kiến nha.
Thanks bác Hải và a/e forum GPE!

 

[Quang_Hải]

đây là file lớn thử nghiệm cùng với sai lệch dòng để kiểm nghiệm code. bác coi qua cho em ý kiến nha.
Thanks bác Hải và a/e forum GPE!

Mình rất khó chịu với những dạng bài lúc đầu thì gởi lên với dữ liệu 1 kiểu, sau đó là là dữ liệu kiểu khác.
Với Sub này thì sửa lại theo dạng dữ liệu mới của bạn. Dữ liệu là từ W5 đến AW2003. Nếu cần bạn cứ thay đổi cho phù hợp. Chú ý các con số 25,26,27 phải thay thế tương ứng

Sub test()
Dim dl(), i, j, n, m, jj, x
[AV5:AW2003].ClearContents
dl = [W5:AW2003].Value
For i = 1 To UBound(dl)
   For j = 25 To 1 Step -1
      If dl(i, j) <> "" Then
         For x = j To 1 Step -1
            If dl(i, x) = "" Then
               n = n + 1
            Else
               If m < n Then m = n
               n = 0
            End If
         Next
         dl(i, 26) = m
         n = 0: m = 0
         Exit For
      End If
   Next
   For j = 25 To 1 Step -1
      If dl(i, j) = "" Then
         n = n + 1
      Else
         Exit For
      End If
   Next
   dl(i, 27) = n
   n = 0
Next
[W5].Resize(i - 1, 27) = dl
End Sub

Để cho an toàn mình viết thêm 2 UDF cho bạn. Cứ xem file sẽ hiểu cách dùng.

Function MaxBlank(vung As Range)
Dim dl(), j, n, m, x
dl = vung.Value
   For j = UBound(dl, 2) To 1 Step -1
      If dl(1, j) <> "" Then
         For x = j To 1 Step -1
            If dl(1, x) = "" Then
               n = n + 1
            Else
               If m < n Then m = n
               n = 0
            End If
         Next
         MaxBlank = m
         Exit For
      End If
   Next
End Function

Function EndBlank(vung As Range)
Dim dl(), j, n
dl = vung.Value
   For j = UBound(dl, 2) To 1 Step -1
      If dl(1, j) = "" Then
         n = n + 1
      Else
         Exit For
      End If
   Next
   EndBlank = n
End Function

 

[qv7tb]

Cảm ơn bác góp ý và viết code giúp em làm hiệu quả.
Thanks a/e forum GPE!