Thử code.
Sub abc()
Dim i As Long, lr As Long, sh As Worksheet, arr, kq, sogio As Double, b As Long, a As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
b = 300
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "tong" Then
sh.Delete
End If
Next sh
With Sheets("tong")
lr = .Range("D" & Rows.Count).End(xlUp).Row
arr = .Range("D4:E" & lr).Value
ReDim kq(1 To UBound(arr)+1, 1 To 2)
kq(1, 1) = "Ma hang"
kq(1, 2) = "so gio"
a = 1
For i = 1 To UBound(arr)
sogio = sogio + arr(i, 2)
If sogio > b Then
Set sh = Worksheets.Add
sh.Range("D3:E3").Resize(a).Value = kq
Erase kq
ReDim kq(1 To UBound(arr), 1 To 2)
a = 1: sogio = arr(i, 2)
kq(1, 1) = "Ma hang"
kq(1, 2) = "so gio"
End If
a = a + 1
kq(a, 1) = arr(i, 1)
kq(a, 2) = arr(i, 2)
Next i
If a Then
Set sh = Worksheets.Add
sh.Range("D3:E3").Resize(a).Value = kq
End If
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End SubSub ABC()
Dim Ws As Worksheet, sArr(), Res(), i&, Temp As Double
Dim K&, n%
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each Ws In Worksheets
If Ws.Name <> "tong" Then
Ws.Delete
End If
Next
If Application.WorksheetFunction.Sum(Sheets("tong").Range("E:E")) > 300 Then
sArr = Sheets("tong").Range("D4:E" & Sheets("tong").Range("D" & Rows.Count).End(3).Row).Value
ReDim Res(1 To UBound(sArr), 1 To 2)
Res(1, 1) = Sheets("tong").Range("D3").Value
Res(1, 2) = Sheets("tong").Range("E3").Value: K = 1
For i = 1 To UBound(sArr)
K = K + 1
Temp = Temp + sArr(i, 2)
Res(K, 1) = sArr(i, 1)
Res(K, 2) = sArr(i, 2)
If Temp > 300 Then
i = i - 1: n = n + 1
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Sheet" & n
ActiveSheet.Range("D3").Resize(K - 1, 2) = Res
K = 1: Temp = 0
End If
Next
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Nếu chỉ có một sheet duy nhất, tức tổng <300 thì redim kq bị thiếu
Mình thử rồi, nhưng xem qua cũng thấy thôi. arr không lấy tiêu đề, còn kq thì dòng đầu ghi tiêu đề nhưng tổng dòng cũng chỉ bằng ubound(arr). Mà nói vậy thôi chứ có 1 sheet thì chắc không ai tách hihi
