Option Explicit
Public Sub GPE()
Dim sArr(), Res()
Dim i As Long, k As Long, sR As Long, eR As Long, j As Byte, sC As Byte
Dim Chuan As Double
With Sheets("Sheet1")
eR = .Range("O" & Rows.Count).End(xlUp).Row
If eR > 2 Then .Range("O3:X" & eR).ClearContents
eR = .Range("A65000").End(xlUp).Row
If eR < 3 Then MsgBox ("Khong co du lieu"): Exit Sub
sArr = .Range("A3:J" & eR).Value
sR = UBound(sArr, 1): sC = UBound(sArr, 2)
End With
ReDim Res(1 To sR * 3, 1 To sC)
For i = 1 To sR
Chuan = sArr(i, 3)
Tiep:
k = k + 1
Res(k, 1) = sArr(i, 1): Res(k, 2) = sArr(i, 2): Res(k, 3) = Chuan
For j = 4 To sC
If sArr(i, j) > Chuan Then
Res(k, j) = Chuan
sArr(i, j) = sArr(i, j) - Chuan
Else
Res(k, j) = sArr(i, j)
sArr(i, j) = 0
End If
Next j
If k = sR * 3 Then
With Sheets("Sheet1")
eR = .Range("O" & Rows.Count).End(xlUp).Row + 1
.Range("O" & eR).Resize(k, sC) = Res
End With
k = 0
ReDim Res(1 To sR * 3, 1 To sC)
End If
For j = 4 To sC
If sArr(i, j) > 0 Then GoTo Tiep
Next j
Next i
If k > 0 Then
With Sheets("Sheet1")
eR = .Range("O" & Rows.Count).End(xlUp).Row + 1
.Range("O" & eR).Resize(k, sC) = Res
End With
End If
End Sub
