Đếm số phần tử

[phuongthu0109]

Mình có file như sau. Mình cần đếm số phần tử của dãy, phân cách nhau bởi khoảng trống.
Cái khó là tốc độ cua chương trình. Nếu code thông thường thì mình cũng làm được:
link file
http://www.mediafire.com/view/9f9qk3c4saht4ce/hoicacban.xlsm

Sub fd()
Dim i As Integer
Dim icuoi As Integer
Dim dem As Integer
Dim vitri As Integer
dem = 0

icuoi = 40
For i = 3 To icuoi Step 1
   If Sheets("Sheet1").Cells(i, 3).Value = "" Then
      Sheets("Sheet1").Cells(vitri, 5).Value = "phan tu:" & dem
      dem = 0
      
   End If
   If Sheets("Sheet1").Cells(i, 3).Value <> "" And Sheets("Sheet1").Cells(i + 1, 3).Value = "" Then
     vitri = i
     dem = dem + 1
   End If
   If Sheets("Sheet1").Cells(i, 3).Value <> "" And Sheets("Sheet1").Cells(i + 1, 3).Value <> "" Then dem = dem + 1
Next i
End Sub

Ai biết xin mách dùm.

 

[lightd]

Cái khó là tốc độ cua chương trình.

Tốc độ chương trình là sao, là nhanh quá, hay chậm quá?? tôi thấy có gần 40 vòng lặp thì chạy chắc nhanh thôi?

 

[phuongthu0109]

Tốc độ chương trình là sao, là nhanh quá, hay chậm quá?? tôi thấy có gần 40 vòng lặp thì chạy chắc nhanh thôi?

Mình xin lỗi, đây là data giả lập vì mình không mang được data về máy cá nhân. thực tế dữ liệu có thể lớn tới 20.000-30.000 dòng dữ liệu.
Mình cần một thuật toán cho tốc độ nhanh. hjc.

 

[lightd]

Mình xin lỗi, đây là data giả lập vì mình không mang được data về máy cá nhân. thực tế dữ liệu có thể lớn tới 20.000-30.000 dòng dữ liệu.
Mình cần một thuật toán cho tốc độ nhanh. hjc.

muốn thế, và nếu đúng các ô "" là các ô rỗng thật sự (ô không chứa gì cả) thì thế này, bạn thử:

Đặt con trỏ vào ô C3, rồi bấm End, tiếp bấm mũi tên xuống --> thấy gì
Tiếp tục bấm phím End rồi bấm phím mũi tên xuống , thấy sao?
Lặp lại tiếp,

Dựa trên điều đó bạn hãy viết trong VBA thuật toán với phương thức
Range(...).End(..), hay Cells(...).End(..)
sẽ di chuyển được như ta thao tác trên, rồi lấy giá trị chỉ số hàng .ROW để xác định số lượng
nếu không rõ thử ghi macro các thao tác trên sẽ hiểu

cuối là kết hợp chúng với vòng lặp DoWhile thì là nhanh thôi

 

[Ba Tê]

Mình xin lỗi, đây là data giả lập vì mình không mang được data về máy cá nhân. thực tế dữ liệu có thể lớn tới 20.000-30.000 dòng dữ liệu.
Mình cần một thuật toán cho tốc độ nhanh. hjc.

Với dữ liệu như file mẫu, thử chạy Sub này cho dữ liệu khoảng 30.000 dòng xem sao.

Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, Num As Long
sArr = Range([C2], [C1000000].End(xlUp)).Value2
K = UBound(sArr, 1)
ReDim dArr(1 To K, 1 To 1)
For I = K To 1 Step -1
    If sArr(I, 1) <> Empty Then
        Num = Num + 1
    Else
        dArr(I + 1, 1) = Num & " phan tu"
        Num = 0
    End If
Next I
Range("E2").Resize(K) = dArr
End Sub

 

[tamthat]

Mình có file như sau. Mình cần đếm số phần tử của dãy, phân cách nhau bởi khoảng trống.
Cái khó là tốc độ cua chương trình. Nếu code thông thường thì mình cũng làm được:
link file
http://www.mediafire.com/view/9f9qk3c4saht4ce/hoicacban.xlsm

Sub fd()
Dim i As Integer
Dim icuoi As Integer
Dim dem As Integer
Dim vitri As Integer
dem = 0

icuoi = 40
For i = 3 To icuoi Step 1
   If Sheets("Sheet1").Cells(i, 3).Value = "" Then
      Sheets("Sheet1").Cells(vitri, 5).Value = "phan tu:" & dem
      dem = 0
      
   End If
   If Sheets("Sheet1").Cells(i, 3).Value <> "" And Sheets("Sheet1").Cells(i + 1, 3).Value = "" Then
     vitri = i
     dem = dem + 1
   End If
   If Sheets("Sheet1").Cells(i, 3).Value <> "" And Sheets("Sheet1").Cells(i + 1, 3).Value <> "" Then dem = dem + 1
Next i
End Sub

Ai biết xin mách dùm.

Bạn thử xem. Tôi kiểm tra qua thấy có vẻ tốc độ cũng khá nhanh. Bạn thử check em có ổn ko nhé.

Sub demphantu()


   a = Range("C" & Rows.Count).End(3).Row
   I = 3
   For v = 1 To a
   K = Range(Cells(I, 3), Cells(I, 3).End(xlDown)).Count
   Cells(I, 5) = K & " phan tu"
   I = I + K + 1
   If I > a Then Exit Sub
   Next


End Sub

 

[comet_1701]

Bạn thử xem. Tôi kiểm tra qua thấy có vẻ tốc độ cũng khá nhanh. Bạn thử check em có ổn ko nhé.

Sub demphantu()


   a = Range("C" & Rows.Count).End(3).Row
   I = 3
   For v = 1 To a
   K = Range(Cells(I, 3), Cells(I, 3).End(xlDown)).Count
   Cells(I, 5) = K & " phan tu"
   I = I + K + 1
   If I > a Then Exit Sub
   Next


End Sub

Với bài của chủ topic hình như là đươc, còn nếu dòng nào đó chỉ có 1 phần tử thì hình như sẽ không chạy đúng nữa? Cảm ơn bạn nhé

 

[phuongthu0109]

Với bài của chủ topic hình như là đươc, còn nếu dòng nào đó chỉ có 1 phần tử thì hình như sẽ không chạy đúng nữa? Cảm ơn bạn nhé

Đúng rồi. Mình sửa lại rồi, nhanh vô đối luôn.

 a = Range("C" & Rows.Count).End(3).Row
   I = 3
   For v = 3 To a
   If Cells(I + 1, 3) = "" Then
   k = 1
   Else
   Cells(I, 3).End(xlDown).Select
   k = Range(Cells(I, 3), Cells(I, 3).End(xlDown)).Count
   End If
   Cells(I, 5) = k & " phan tu"
   
   I = I + k + 1
   If I > a Then Exit Sub
   Next

 

[tamthat]

Với bài của chủ topic hình như là đươc, còn nếu dòng nào đó chỉ có 1 phần tử thì hình như sẽ không chạy đúng nữa? Cảm ơn bạn nhé

Hj, mình ko để ý, thanks bạn!

 

[tamthat]

Đúng rồi. Mình sửa lại rồi, nhanh vô đối luôn.

 a = Range("C" & Rows.Count).End(3).Row
   I = 3
   For v = 3 To a
   If Cells(I + 1, 3) = "" Then
   k = 1
   Else
   Cells(I, 3).End(xlDown).Select
   k = Range(Cells(I, 3), Cells(I, 3).End(xlDown)).Count
   End If
   Cells(I, 5) = k & " phan tu"
   
   I = I + k + 1
   If I > a Then Exit Sub
   Next

Chắc bạn sửa lại vẫn chưa ổn. Mình sửa lại, đã kiểm tra kỹ (loại trừ cả trường hợp có 2 dòng trống liên tiếp). Hi vọng đúng ý bạn

Sub demphantu()
   a = Range("C" & Rows.Count).End(3).Row
   I = 3
   For v = 3 To a
   If Cells(I, 3) <> 0 And Cells(I + 1, 3) <> 0 Then
        K = Range(Cells(I, 3), Cells(I, 3).End(xlDown)).Count
        Cells(I, 5) = K & " phan tu"
        I = I + K + 1
   Else
        I = I + 1
   If Cells(I, 3) = 0 And Cells(I - 1, 3) <> 0 Then Cells(I - 1, 5) = 1 & " phan tu"
   End If
        If I > a Then Exit Sub
   Next
End Sub

Nếu code kia bạn vẫn dùng thì theo tôi nên bỏ dòng

Cells(I, 3).End(xlDown).Select

Dòng này không có tác dụng gì cả. Nếu bạn dùng

K = Range(Selection, Selection.End(xlDown)).Count

thì mới cần để lại dòng trên. Ở đây, bạn đã gán trực tiếp vào rồi, cần gì phải select nữa.