Sub wanao()
Dim Max As Integer, Min As Integer
Dim Arr, x, He As Integer, Qh As Integer
Max = [bh5]
Min = [bh4]
For x = 7 To Sheet1.UsedRange.Rows.Count
Set Arr = Range("Q" & x & ":S" & x)
Qh = Application.WorksheetFunction.Sum(Arr)
If Qh >= Min And Qh <= Max Then He = He + 1
Set Arr = Range("AG" & x & ":AI" & x)
Qh = Application.WorksheetFunction.Sum(Arr)
If Qh >= Min And Qh <= Max Then He = He + 1
Set Arr = Range("AW" & x & ":AY" & x)
Qh = Application.WorksheetFunction.Sum(Arr)
If Qh >= Min And Qh <= Max Then He = He + 1
Cells(x, "bh") = He
He = 0
Next
Sub wanao()
Dim Max As Integer, Min As Integer
Dim Arr, x, He As Integer, Qh As Integer
Max = [bh5]
Min = [bh4]
For x = 7 To Sheet1.UsedRange.Rows.Count
Set Arr = Range("Q" & x & ":S" & x)
Qh = Application.WorksheetFunction.Sum(Arr)
If Qh >= Min And Qh <= Max Then He = He + 1
Set Arr = Range("AG" & x & ":AI" & x)
Qh = Application.WorksheetFunction.Sum(Arr)
If Qh >= Min And Qh <= Max Then He = He + 1
Set Arr = Range("AW" & x & ":AY" & x)
Qh = Application.WorksheetFunction.Sum(Arr)
If Qh >= Min And Qh <= Max Then He = He + 1
Cells(x, "bh") = He
He = 0
Next