Em muốn đếm số thứ tự bằng macro? (4 người xem)

[mythuat4p]

Em đang học macro. Giúp em với.
Em muốn học cách đếm STT bằng Macro

 

[TrungChinhs]

Bạn dùng thử cách này.

Sub STT()
    Range("G4:G100").Select
    Selection = "=IF(RC[-1]=0,"""",COUNTIF(R4C6:RC[-1],"">0""))"
    Selection = Selection.Value
End Sub

hoặc viết lại như thế này

Sub STT()
    [G5:G1000] = "=IF(RC[-1]=0,"""",COUNTIF(R4C6:RC[-1],"">0""))"
    [G5:G1000] = [G5:G1000].Value
End Sub

 

[mythuat4p]

Bạn ơi có thể cho nó chạy tự động mà không cần ấn nút không

 

[TrungChinhs]

Bạn muốn nó tự động ở sheet nào thì dán đoạn code này vài sheet đó (bạn xem lại bài trên tôi đã sửa)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call STT
End Sub

 

[ndu96081631]

Bạn ơi có thể cho nó chạy tự động mà không cần ấn nút không

Tự động nghĩa là sao? Bạn nói rõ hơn chút đi ---> Khi bạn làm gì thì STT sẽ điền?

 

[khaiktt]

Em có một ý tưởng nhỏ trong file đính kèm, xin nhờ cả nhà giúp cho ạ

 

[Quang_Hải]

Em có một ý tưởng nhỏ trong file đính kèm, xin nhờ cả nhà giúp cho ạ

Sub STT_Thieu()
Dim data(), i As Long
data = Range([a2], [A65536].End(3)).Value
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(data)
      If Not .exists(data(i, 1)) Then .Add data(i, 1), ""
   Next
   For i = 1 To [A65536].End(3).Value
      If Not .exists(i) Then
         Cells(65536, 5).End(3).Offset(1) = i
      End If
   Next
End With
End Sub

 

[ndu96081631]

Sub STT_Thieu()
Dim data(), i As Long
data = Range([a2], [A65536].End(3)).Value
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(data)
      If Not .exists(data(i, 1)) Then .Add data(i, 1), ""
   Next
   For i = 1 To [A65536].End(3).Value
      If Not .exists(i) Then
         Cells(65536, 5).End(3).Offset(1) = i
      End If
   Next
End With
End Sub

Code này chưa chính xác nha.
Xóa cell A18 (số 19) nhưng code cũng không tìm ra được số 19 bị thiếu
Tôi nghĩ dùng Advanced Filter cũng được:

Sub Main()
  Dim rCrit As Range, rData As Range, rOrgn As Range, Target As Range
  Set rData = Range("A1:A1000")
  Set rOrgn = Range("C1:C1000")
  Set rCrit = Range("IV1:IV2")
  rCrit(2, 1).Value = "=COUNTIF(" & rData.Offset(1).Address & "," & rOrgn(2, 1).Address(0, 1) & ")=0"
  Set Target = Range("E1")
  rOrgn.AdvancedFilter 2, rCrit, Target
  Target(1, 1).Value = "So thieu"
  rCrit.Clear
End Sub

 

[Quang_Hải]

Code này chưa chính xác nha.
Xóa cell A18 (số 19) nhưng code cũng không tìm ra được số 19 bị thiếu

Em đâu có so sánh với cột C đâu cho nên code của em đúng rồi. Tác giả có kêu so sánh gì đâu nên viết thí và em cũng không có lời thắc mắc gì ráo. Nếu không đúng tự nhiên họ sẽ la lên thôi.

 

[khaiktt]

Sub STT_Thieu()
Dim data(), i As Long
data = Range([a2], [A65536].End(3)).Value
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(data)
      If Not .exists(data(i, 1)) Then .Add data(i, 1), ""
   Next
   For i = 1 To [A65536].End(3).Value
      If Not .exists(i) Then
         Cells(65536, 5).End(3).Offset(1) = i
      End If
   Next
End With
End Sub

Cảm ơn bác đã quan tâm vấn đề của em, bác đã giúp em rất nhiều, kính chúc bác mạnh khoẻ và thành đạt

 

[khaiktt]

Code này chưa chính xác nha.
Xóa cell A18 (số 19) nhưng code cũng không tìm ra được số 19 bị thiếu
Tôi nghĩ dùng Advanced Filter cũng được:

Sub Main()
  Dim rCrit As Range, rData As Range, rOrgn As Range, Target As Range
  Set rData = Range("A1:A1000")
  Set rOrgn = Range("C1:C1000")
  Set rCrit = Range("IV1:IV2")
  rCrit(2, 1).Value = "=COUNTIF(" & rData.Offset(1).Address & "," & rOrgn(2, 1).Address(0, 1) & ")=0"
  Set Target = Range("E1")
  rOrgn.AdvancedFilter 2, rCrit, Target
  Target(1, 1).Value = "So thieu"
  rCrit.Clear
End Sub

Cam ơn bác đã quan tâm, kkhi em chạy có phát sinh lỗi này ạ

 

[khaiktt]

Kính gửi bác Quang Hai
Khi em bổ xung thêm số liệu có phát sinh thêm vấn đề nữa, xin bác vui lòng xem file em gửi kèm
Xin cảm ơn bác nhiều

 

[Quang_Hải]

Kính gửi bác Quang Hai
Khi em bổ xung thêm số liệu có phát sinh thêm vấn đề nữa, xin bác vui lòng xem file em gửi kèm
Xin cảm ơn bác nhiều

Bạn xem file. Lưu ý là mình chỉ dựa trên cột A thôi nhá.

Sub STT_Thieu()
Dim data(), i As Long
data = Range([A2], [A65536].End(3)).Value
[E2:E10000].ClearContents
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(data)
      If Not .exists(data(i, 1)) Then .Add data(i, 1), ""
   Next
   For i = [A2].Value To [A65536].End(3).Value
      If Not .exists(i) Then
         Cells(65536, 5).End(3).Offset(1) = i
      End If
   Next
End With
End Sub

 

[khaiktt]

Bạn xem file. Lưu ý là mình chỉ dựa trên cột A thôi nhá.

Sub STT_Thieu()
Dim data(), i As Long
data = Range([A2], [A65536].End(3)).Value
[E2:E10000].ClearContents
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(data)
      If Not .exists(data(i, 1)) Then .Add data(i, 1), ""
   Next
   For i = [A2].Value To [A65536].End(3).Value
      If Not .exists(i) Then
         Cells(65536, 5).End(3).Offset(1) = i
      End If
   Next
End With
End Sub

Xin cảm ơn bác rất nhiều. Đã đúng với nhu cầu của em rồi. Một lần nữa kính chúc bác mạnh khoẻ và thành đạt hơn nữa

 

[khaiktt]

Cảm ơn bác đã quan tâm vấn đề của em, bác đã giúp em rất nhiều, kính chúc bác mạnh khoẻ và thành đạt

Kinh gui Bac Quang Hai
EM bị phát sinh thêm một vấn đề trong bảng dữ liệu như sau
Gia sử trong cột A có 02 bản ghi trở lên có số giống nhau liệu có thể tạo một Macro để lọc các bản ghi đó rồi coppy ra cho khác được không ạ
Trân trọng cảm ơn sự giúp đỡ của Bác

 

[TrungChinhs]

Kinh gui Bac Quang Hai
EM bị phát sinh thêm một vấn đề trong bảng dữ liệu như sau
Gia sử trong cột A có 02 bản ghi trở lên có số giống nhau liệu có thể tạo một Macro để lọc các bản ghi đó rồi coppy ra cho khác được không ạ
Trân trọng cảm ơn sự giúp đỡ của Bác

Tranh thủ Bac Quang Hai vừa đi ra ngoài.

Bạn có thể dùng Autofilter để làm việc này (vì không thời gian làm không nhiều hơn thời gian bạn đọc xong dòng này).
Ví dụ: Tại F2 nhập công thức =COUNTIF(A$2:A2;A2) rồi fill xuống hết bảng tính. Bôi đen cột F dùng Autofilter lọc với điều kiện 1 và does not equal.