Xin hướng dẫn cách tự động chạy macro khi tính toán? (1 người xem)

[bluesky9134]

Chào cả nhà, e có ngồi mò trên mạng thì tìm đc đoạn code đếm các ô tô màu.

E đưa vào thì chạy bt nhưng nó có 1 điểm hạn chế là cứ mỗi lần em tô màu thì nó ko tự tính được, mà phải chạy qua kich vào ô công thức cho nó tính.

Mọi người giúp e làm sao để cho nó tự tính mỗi khi e tô màu với. Em cảm ơn!

 

[doveandrose]

bạn cần làm như sau :

 

[bluesky9134]

Là sao bạn? Cái hình nó cứ nhỏ xíu nhỉ?

bạn cần làm như sau :

View attachment 153695



View attachment 153696

 

[giaiphap]

Là sao bạn? Cái hình nó cứ nhỏ xíu nhỉ?

Nếu vậy bạn up file đó lên đây để mọi người sửa giúp chứ đưa cái hình chẳng ai giúp đâu.

 

[anhdepjai]

Bạn vào chỗ FOMULAS\CALCULATION OPTIONS chuyển nó thành automatic nhé

 

[bluesky9134]

Mình up rồi, bạn xem giùm mình với.

Nếu vậy bạn up file đó lên đây để mọi người sửa giúp chứ đưa cái hình chẳng ai giúp đâu.

 

[bluesky9134]

Mình chỉnh cái đó rồi mà không được bạn, mình nghĩ cái này là do cái macro mình viết, ko biết làm sao để nó tự động chạy cả.

Bạn vào chỗ FOMULAS\CALCULATION OPTIONS chuyển nó thành automatic nhé

 

[chuot0106]

Mình chỉnh cái đó rồi mà không được bạn, mình nghĩ cái này là do cái macro mình viết, ko biết làm sao để nó tự động chạy cả.

Bạn chép code này vào File của bạn!(Chỗ đỏ đỏ mới thêm)
Muốn cập nhật bạn nhấn phím F9.

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim rCell As Range
Dim lCol As Long
Dim vResult
[COLOR=#ff0000]Application.Volatile[/COLOR]
lCol = rColor.Interior.ColorIndex
If SUM = True Then
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = WorksheetFunction.SUM(rCell, vResult)
End If
Next rCell
Else
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = 1 + vResult
End If
Next rCell
End If
ColorFunction = vResult
End Function

 

[bluesky9134]

Có cách nào có thể tự cập nhật mỗi lần mình đổ màu luôn ko bạn? Chứ cứ tô 1,2 ô rồi F9 thì mình thấy cũng hơi mất công. Thanks bạn.

Bạn chép code này vào File của bạn!(Chỗ đỏ đỏ mới thêm)
Muốn cập nhật bạn nhấn phím F9.

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim rCell As Range
Dim lCol As Long
Dim vResult
[COLOR=#ff0000]Application.Volatile[/COLOR]
lCol = rColor.Interior.ColorIndex
If SUM = True Then
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = WorksheetFunction.SUM(rCell, vResult)
End If
Next rCell
Else
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = 1 + vResult
End If
Next rCell
End If
ColorFunction = vResult
End Function

 

[ppc0312]

Có cách nào có thể tự cập nhật mỗi lần mình đổ màu luôn ko bạn? Chứ cứ tô 1,2 ô rồi F9 thì mình thấy cũng hơi mất công. Thanks bạn.

Nếu không muốn bấm F9, có 2 cách:

Cách 1: đơn giản là dùng Worksheet_SelectionChange bạn có thể chỉ cần click chuột sang cell khác thì sẽ tự động tính

Cách 2: Sau khi tô màu thì ô function tính luôn, thì code phức tạp hơn.
Bạn thử search google đi là thấy.

 

[ppc0312]

Cách 1 đây, RightClick lên Tab Sheet "Thang 10" chọn ViewCode, và dán đoạn code sau vào

Option Explicit

Private Const AddRangeFillColor = "B11:AF20"
Private Const AddRangeCalculate = "AI11:AJ20"

Private OldSelection As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If OldSelection Is Nothing Then Set OldSelection = Range(AddRangeFillColor)
    If Not (Intersect(Range(AddRangeFillColor), OldSelection) Is Nothing) Then
        Range(AddRangeCalculate).Calculate
    End If
    Set OldSelection = Target
End Sub

Sau khi tô màu bạn có thể chỉ cần click chuột sang cell khác thì hàm sẽ tự động tính

 

[bluesky9134]

Cảm ơn bạn nhiều nhé

Cách 1 đây, RightClick lên Tab Sheet "Thang 10" chọn ViewCode, và dán đoạn code sau vào

Option Explicit

Private Const AddRangeFillColor = "B11:AF20"
Private Const AddRangeCalculate = "AI11:AJ20"

Private OldSelection As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If OldSelection Is Nothing Then Set OldSelection = Range(AddRangeFillColor)
    If Not (Intersect(Range(AddRangeFillColor), OldSelection) Is Nothing) Then
        Range(AddRangeCalculate).Calculate
    End If
    Set OldSelection = Target
End Sub

Sau khi tô màu bạn có thể chỉ cần click chuột sang cell khác thì hàm sẽ tự động tính

 

[bluesky9134]

Mọi người ơi, em chép công thức của mọi người chạy ok rồi. Nhưng xảy ra thêm 1 lỗi này: Nếu e tắt file đi và bật lại thì nó ko chạy, phải kích vào ô chứa công thức đếm ô màu kia, rồi nhấn Enter thì code ở trên mới chạy được.

Làm phiền mọi người giúp e nốt cái này với ạ, làm sao để mở file excel lên lại thì nó chạy luôn ạ? Em cảm ơn