Đếm các ô liên tiếp bằng VBA (1 người xem)

1986QV · 12/6/12

em có file sau mong các anh chị giúy em đếm các ô liên tiếp bằng VBA thay vì countif dùm em
Cảm ơn mọi người quan tâm!

Quang_Hải · 12/6/12

Thử code này coi sao
Sub dem()
Application.ScreenUpdating = False
Dim i, r, k, vung
Set C = Cells
vung = UsedRange
i = UsedRange.Row
k = UBound(vung)
k = k + i - 1
For r = i To k
C(r, 14) = Application.CountBlank(Range(C(r, 1), C(r, 13)))
Next
Application.ScreenUpdating = True
End Sub

1986QV · 12/6/12

Cảm ơn bác. Nhưng mảng của là mảng động khi thay vào lại không đúng như file sau bác xem lại dùm em.

View attachment Dem lai.xlsx

thanhsangnguyen1982 · 12/6/12

Đếm bằng VBA

Bạn xem file, có ok không

ndu96081631 · 12/6/12

Nghĩ cũng hơi mắc cười!
Đằng nào thì cũng dùng COUNTBLANK, vậy sao không gõ trực tiếp vào cell (chẳng hạn =COUNTBLANK(A1:M1) ...)
Còn nếu viết thành code VBA thì nên viết theo kiểu xử lý mảng nhầm tăng tốc độ tính toán ---> Khi ấy ta sẽ không dùng đến hàm COUNTBLANK trong code VBA
---------------
Ngoài ra xin nói ngoài lề một chút: Rõ ràng tiêu đề là Đếm các ô liên tiếp bằng VBA ---> Vậy chổ nào trong code hoặc công thức mô tả cái vụ LIÊN TIẾP kia?

thanhsangnguyen1982 · 12/6/12

quanghai1969 đã viết:
Thử code này coi sao
Sub dem()
Application.ScreenUpdating = False
Dim i, r, k, vung
Set C = Cells
vung = UsedRange
i = UsedRange.Row
k = UBound(vung)
k = k + i - 1
For r = i To k
C(r, 14) = Application.CountBlank(Range(C(r, 1), C(r, 13)))
Next
Application.ScreenUpdating = True
End Sub

Code của anh quang hai chinh lại tí xíu
Sub dem()
Application.ScreenUpdating = False
Dim i, r, k, vung, c
Set c = Cells
vung = UsedRange
k = UBound(vung)
For r = 1 To k
c(r, 14) = Application.CountBlank(Range(c(r, 1), c(r, 13)))
Next
Application.ScreenUpdating = True
End Sub

1986QV · 12/6/12

ndu96081631 đã viết:
Nghĩ cũng hơi mắc cười!
Đằng nào thì cũng dùng COUNTBLANK, vậy sao không gõ trực tiếp vào cell (chẳng hạn =COUNTBLANK(A1:M1) ...)
Còn nếu viết thành code VBA thì nên viết theo kiểu xử lý mảng nhầm tăng tốc độ tính toán ---> Khi ấy ta sẽ không dùng đến hàm COUNTBLANK trong code VBA
---------------
Ngoài ra xin nói ngoài lề một chút: Rõ ràng tiêu đề là Đếm các ô liên tiếp bằng VBA ---> Vậy chổ nào trong code hoặc công thức mô tả cái vụ LIÊN TIẾP kia?

Bài em đăng có nhầm 1 chút đếm có điều kiện. Mục đích bài đếm các ô kế tiếp cuối cùng.
Bác ah đếm các ô kế tiếp nhau cuối giống 1 bài bác đã viết rồi đó (VD =COLUMN()-LOOKUP(2,1/(V5:""),COLUMN(B2:K2))-1 ). Em nảy ra ý này giảm dung lượng file và tốc độ bác ah. Thanks bác!

1986QV · 12/6/12

em có file sau mong các anh chị giúy em đếm các ô liên tiếp bằng VBA thay vì countif dùm em
Cảm ơn mọi người quan tâm!

em xin dính chính lại file và viết code đếm ô liên tiếp cuối cùng
View attachment Dem Tu dong bang VBA.xlsx

Quang_Hải · 12/6/12

Thử lại xem sao, cũng không biết là cuối cùng của bạn là so sánh với cột nào.

Sub Dem()
Application.ScreenUpdating = False
Dim i, r, k, j, n, vung, c
Dim Arr()
Set c = Cells
vung = UsedRange
i = UsedRange.Row
j = UBound(vung)
k = j + i - 1
ReDim Arr(1 To j, 1 To 1)
For r = i To k
n = n + 1
Arr(n, 1) = c(r, 14).Column - c(r, 14).End(1).Column
Next
Cells(i, 15).Resize(n, 1) = Arr
Application.ScreenUpdating = True
End Sub

Quang_Hải · 12/6/12

thanhsangnguyen1982 đã viết:
Code của anh quang hai chinh lại tí xíu
Sub dem()
Application.ScreenUpdating = False
Dim i, r, k, vung, c
Set c = Cells
vung = UsedRange
k = UBound(vung)
For r = 1 To k
c(r, 14) = Application.CountBlank(Range(c(r, 1), c(r, 13)))
Next
Application.ScreenUpdating = True
End Sub

Chỉ sợ nếu dữ liệu không bắt đầu từ dòng 1 nên mình phải thêm i=usedrange.row

ndu96081631 · 12/6/12

1986QV đã viết:
em có file sau mong các anh chị giúy em đếm các ô liên tiếp bằng VBA thay vì countif dùm em
Cảm ơn mọi người quan tâm!

em xin dính chính lại file và viết code đếm ô liên tiếp cuối cùng
View attachment 83766

Thử code xem sao:
1> Hàm hổ trợ

PHP:

Function LastBlanks(ByVal SrcRng As Range)
  Dim Arr(), tmpArr, tmp As String
  Dim lR As Long, lC As Long, n As Long
  On Error Resume Next
  tmpArr = SrcRng.Value
  ReDim Arr(1 To UBound(tmpArr, 1), 1 To 1)
  For lR = 1 To UBound(tmpArr, 1)
    lC = UBound(tmpArr, 2)
    tmp = CStr(tmpArr(lR, lC))
    Do While Len(tmp) = 0
      lC = lC - 1
      If lC <= 0 Then Exit Do
      tmp = CStr(tmpArr(lR, lC))
    Loop
    Arr(lR, 1) = UBound(tmpArr, 2) - lC
  Next
  LastBlanks = Arr
End Function

2> Code chính để chạy:

PHP:

Sub Main()
  Dim Arr, SrcRng As Range
  Set SrcRng = Range("A1:M14")
  Arr = LastBlanks(SrcRng)
  SrcRng.Offset(, SrcRng.Columns.Count).Resize(, 1).Value = Arr
End Sub

Nếu dữ liệu khác hơn, hãy khai báo lại biến SrcRng

1986QV · 12/6/12

quanghai1969 đã viết:
Thử lại xem sao, cũng không biết là cuối cùng của bạn là so sánh với cột nào.

Sub Dem()
Application.ScreenUpdating = False
Dim i, r, k, j, n, vung, c
Dim Arr()
Set c = Cells
vung = UsedRange
i = UsedRange.Row
j = UBound(vung)
k = j + i - 1
ReDim Arr(1 To j, 1 To 1)
For r = i To k
n = n + 1
Arr(n, 1) = c(r, 14).Column - c(r, 14).End(1).Column
Next
Cells(i, 15).Resize(n, 1) = Arr
Application.ScreenUpdating = True
QUÓToQUỐTEnd Sub[/QUÓT

cuối cùng của em so với điểm cuối có số 1 và bắt đầu đếm từ đó
View attachment Dem lai.xlsx

ndu96081631 · 12/6/12

1986QV đã viết:
cuối cùng của em so với điểm cuối có số 1 và bắt đầu đếm từ đó

Bạn sửa code của tôi lại chút là được rồi:

PHP:

Function LastBlanks(ByVal SrcRng As Range, Inc As Long)
  Dim Arr(), tmpArr, tmp As String
  Dim lR As Long, lC As Long, n As Long
  On Error Resume Next
  tmpArr = SrcRng.Value
  ReDim Arr(1 To UBound(tmpArr, 1), 1 To 1)
  For lR = 1 To UBound(tmpArr, 1)
    lC = UBound(tmpArr, 2)
    tmp = CStr(tmpArr(lR, lC))
    Do While Len(tmp) = 0
      lC = lC - 1
      If lC <= 0 Then Exit Do
      tmp = CStr(tmpArr(lR, lC))
    Loop
    Arr(lR, 1) = UBound(tmpArr, 2) - lC + Inc
  Next
  LastBlanks = Arr
End Function

PHP:

Sub Main()
  Dim Arr, SrcRng As Range, Inc As Long
  Inc = 6
  Set SrcRng = Range("A1:J27")
  Arr = LastBlanks(SrcRng, Inc)
  Range("R1").Resize(UBound(Arr, 1)).Value = Arr
End Sub

Cái gia số Inc ở trên tôi cho = 6 (tức tính từ cột K đến cột P) ---> Với dữ liệu khác, bạn tự chỉnh lấy nhé

1986QV · 12/6/12

bác [h=2]ndu96081631[/h]viết chuẩn không cần chỉnh luôn. Em có ý nếu mở rộng ra đếm các ô kê tiếp đó sau so sánh các khoảng đó max or min thì sao đây??? bài toán này nghe rất khó. Các bác thử xem sao???
Cảm ơn mọi người quan tâm!

1986QV · 12/6/12

Bác viết lần đầu rất chuẩn chỉnh lại hỏng hay do bác hiểu nhầm ý em. Bắt đầu đếm từ điểm 1 cuối cùng từ trái qua phải liên tục không gián đoạn tại đâu như file trên. chứ không phải đếm tất cả các ô trống bác ah.
Rất cảm ơn mọi người quan tâm!
View attachment Dem Tu dong bang VBA.xlsx

Ba Tê · 12/6/12

1986QV đã viết:
Bác viết lần đầu rất chuẩn chỉnh lại hỏng hay do bác hiểu nhầm ý em. Bắt đầu đếm từ điểm 1 cuối cùng từ trái qua phải liên tục không gián đoạn tại đâu như file trên. chứ không phải đếm tất cả các ô trống bác ah.
Rất cảm ơn mọi người quan tâm!
View attachment 83784

Public Function GPE(Rng As Range) As Long
Dim K As Long, Clls As Range
For Each Clls In Rng
If Clls.Value = "" Then
K = K + 1
Else
K = 0
End If
Next
GPE = K
End Function

ndu96081631 · 12/6/12

1986QV đã viết:
Bác viết lần đầu rất chuẩn chỉnh lại hỏng hay do bác hiểu nhầm ý em. Bắt đầu đếm từ điểm 1 cuối cùng từ trái qua phải liên tục không gián đoạn tại đâu như file trên. chứ không phải đếm tất cả các ô trống bác ah.
Rất cảm ơn mọi người quan tâm!

Hỏi lòng vòng sao lại quay về cái cũ thế này? Yêu cầu của bạn đã được giải quyết tại bài 11 rồi còn gì

Đếm các ô liên tiếp bằng VBA (1 người xem)

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

Thành viên hoạt động

File đính kèm

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

Thành viên hoạt động

Thành viên bị đình chỉ hoạt động

File đính kèm

Huyền thoại GPE

Thành viên bị đình chỉ hoạt động

Thành viên hoạt động

Thành viên hoạt động

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

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

Huyền thoại GPE

Thành viên hoạt động

Huyền thoại GPE

Thành viên hoạt động

Thành viên hoạt động

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

File đính kèm

Huyền thoại GPE

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