Kết quả gán cột I
Sub xyz()
Dim arr(), res()
Dim sR&, i&, k&, N&, ct, ma$, S#, thue#, nhom&
'Set dic = CreateObject("scripting.dictionary")
With Sheets("Sheet1")
arr = .Range("C7:G" & .Range("F7").End(xlDown).Row + 1).Value
End With
sR = UBound(arr) - 1
ReDim res(1 To sR * 3, 1 To 5)
For i = 1 To sR
If ct <> arr(i, 1) Then
ct = arr(i, 1): ma = arr(i, 3)
thue = 0: S = 0: nhom = 1
End If
k = k + 1
res(k, 1) = arr(i, 1)
res(k, 2) = arr(i, 2)
res(k, 3) = arr(i, 4)
res(k, 5) = nhom
S = S + arr(i, 4)
thue = thue + arr(i, 5)
If ct <> arr(i + 1, 1) Or ma <> arr(i + 1, 3) Then
k = k + 1
res(k, 1) = arr(i, 1)
res(k, 2) = arr(i, 3)
res(k, 4) = S + thue
res(k, 5) = nhom
S = 0
k = k + 1
res(k, 1) = arr(i, 1)
res(k, 2) = "Tien thue"
res(k, 3) = thue
res(k, 5) = nhom
thue = 0
nhom = nhom + 1
End If
Next i
Sheets("Sheet1").Range("I7").Resize(k, 5) = res
End SubNhờ anh xem lại giúp em dữ liệu như trong file đính kèm thì kết quả không đúng, và nếu kết quả tiền thuế = 0 thì không hiện dòng tiền thuế, cảm ơn anh ạ.
Không đúng như thế nào? Bạn gởi file với đuôi .xlsx với tất cả tình huống có thể có và kết quả mong muốn
Em có gửi lại file, chỗ sai em đã bôi vàng và kết quả mong muốn em để ở bảng tính 2. em cảm ơn ạ
TThêm lệnh sort và xét tiền thuế >0
Sub xyz()
Dim arr(), res()
Dim sR&, i&, k&, N&, ct, ma$, S#, thue#, nhom&
With Sheets("Sheet1")
i = .Range("F7").End(xlDown).Row
res = .Range("C7:G" & i).Value
.Range("C7:G" & i).Sort .Range("C7"), 1, .Range("E7"), , 1, Header:=xlNo 'Sort du lieu
arr = .Range("C7:G" & .Range("F7").End(xlDown).Row + 1).Value
.Range("C7:G" & i) = res 'Tra lai du lieu goc
End With
sR = UBound(arr) - 1
ReDim res(1 To sR * 3, 1 To 5)
For i = 1 To sR
If ct <> arr(i, 1) Then
ct = arr(i, 1): ma = arr(i, 3)
thue = 0: S = 0: nhom = 1
End If
k = k + 1
res(k, 1) = arr(i, 1)
res(k, 2) = arr(i, 2)
res(k, 3) = arr(i, 4)
res(k, 5) = nhom
S = S + arr(i, 4)
thue = thue + arr(i, 5)
If ct <> arr(i + 1, 1) Or ma <> arr(i + 1, 3) Then
k = k + 1
res(k, 1) = arr(i, 1)
res(k, 2) = arr(i, 3)
res(k, 4) = S + thue
res(k, 5) = nhom
S = 0
If thue > 0 Then 'Chi xet thue>0
k = k + 1
res(k, 1) = arr(i, 1)
res(k, 2) = "Tien thue"
res(k, 3) = thue
res(k, 5) = nhom
thue = 0
End If
nhom = nhom + 1
End If
Next i
Sheets("Sheet1").Range("I7").Resize(k, 5) = res
End SubLàm phiền anh xíu, trường hợp em muốn đưa dòng " tiền thuế " lên như hình thì sửa thế nào ạ?
Đưa cụm lệnh tính thuế
If thue > 0 Then 'Chi xet thue>0
k = k + 1
res(k, 1) = arr(i, 1)
res(k, 2) = "Tien thue"
res(k, 3) = thue
res(k, 5) = nhom
thue = 0
End If k = k + 1
res(k, 1) = arr(i, 1)
res(k, 2) = arr(i, 3)
res(k, 4) = S + thue
res(k, 5) = nhom
S = 0Em đưa lên trên thì dòng thuế đã lên trên nhưng cột tiền 2 lại sai kết quả không cộng tiền thuế vào.
Chỉnh lại . . .
If thue > 0 Then 'Chi xet thue>0
k = k + 1
res(k, 1) = arr(i, 1)
res(k, 2) = "Tien thue"
res(k, 3) = thue
res(k, 5) = nhom
End If
k = k + 1
res(k, 1) = arr(i, 1)
res(k, 2) = arr(i, 3)
res(k, 4) = S + thue
res(k, 5) = nhom
thue = 0: S = 0Gởi file với cấu trúc dữ liệu thật với vị trí chính xác các bảng, dữ liệu giả lập mới xử lý triệt để được
Dạ vì dữ liệu nguồn thay đổi lúc nhiều dòng, lúc có 1 dòng đó anh.
Mình muốn biết vị trí chính xác của dữ liệu và kết quả, lúc đó mới xác định đúng vùng dữ liệu
