Chuyển Nhật ký chung 1 cột Tài khoản phát sinh thành 2 cột Nợ - Có

[yencenco]

Ai có code chuyển đổi sổ Nhật ký chung dạng 1 cột Tài khoản phát sinh thành kiểu 2 cột Nợ Có cho em xin với.
Cám ơn mọi người nhiều.
Ví dụ:
Dạng 1 cột TK:
Ngày tháng ghi sổ - Chứng từ - Diễn giải - Đã ghi sổ cái - Số hiệu Tài khoản - Số phát sinh (Nợ - Có)
Dạng 2 cột Nợ - Có:
Ngày tháng ghi sổ - Chứng từ - Diễn giải - Đã ghi sổ cái - Nợ - Có - Số phát sinh

View more random threads:

• NỘP LẠI BCTC Như thế nào?
• Kiểm tra sổ sách báo cáo trước khi lên báo cáo tài chính
• bao cao tai chinh
• Hình thức ghi sổ
• Nộp lại BCTC
• Nên lập báo cáo tài chính thế nào?
• Tò khai QToán Thuế TNDN năm 2014 theo TT156 hay TT28?
• cho vào đâu của BCĐKT theo QĐ 48?
• báo cáo quyết toán thuế năm 2011
• Mình mới thành lập doanh nghiệp cho mình hỏi nhé

[thardeco]

em có tìm được code từ mấy năm trước, nhưng thay đổi nhiều lần vẫn chưa thấy có code nào em làm được cả.
Ai cho em ý kiến với!!!!
(Em không đính kèm file được ạ.)

[boylangtu]

Sao không ai đọc rồi trả lời vậy ạ :-((
Em có tìm được đoạn code của anh HoangDanh từ mấy năm trước nhưng dùng vào Nhật ký chung của công ty em thì kết quả vẫn bị lệch. Ai cho em xin ý kiến vớiiiiiiiii!
CODE:

Sub Taoso()
Dim i As Long, Rw As Long, t As Double
Dim Chungtu As Range, Ci8 As Range, Ci9 As Range
Dim DK1 As Boolean, Dk2 As Boolean, Dk3 As Boolean, Dk4 As Boolean
Application.ScreenUpdating = False
t = Timer
Range("A7:I65536").ClearContents
With Sheets("DATA")
Rw = .[D65536].End(xlUp).Row
Set Chungtu = .Range("A7:A" & Rw)
End With
With Chungtu
.Resize(, 4).Copy Destination:=[A7]
.Offset(, 6).Copy Destination:=[G7]
.Offset(, 4).Resize(, 2).Copy Destination:=[H7]
End With
Set Chungtu = Nothing
For i = 7 To [D65536].End(xlUp).Row
With Cells(i, 5)
Set Ci8 = .Offset(, 3): Set Ci9 = .Offset(, 4)
DK1 = ((Cells(i, 1) = Cells(i + 1, 1)) * (.Offset(, 3) > 0)) = 1
Dk2 = ((Cells(i, 1) = Cells(i - 1, 1)) * (.Offset(, 3) > 0)) = 1
Dk3 = ((Cells(i, 1) = Cells(i + 1, 1)) * (.Offset(, 4) > 0)) = 1
Dk4 = ((Cells(i, 1) = Cells(i - 1, 1)) * (.Offset(, 4) > 0)) = 1
'-------------------------------------------------------------------------------------
'1a.> 1 No 1 Co voi No truoc
If DK1 And Ci8 = Cells(i + 1, 9) Then
.Value = Cells(i + 1, 4)
'1b.> 1 No 1 Co voi Co truoc
ElseIf Dk2 And Ci8 = Cells(i - 1, 9) Then
.Value = Cells(i - 1, 4)
'2a.> 2 No 1 Co voi No truoc
ElseIf DK1 And Ci8 + Cells(i + 1, 8-) = Cells(i + 2, 9) Then
.Value = Cells(i + 2, 4)
ElseIf DK1 And Ci8 + Cells(i - 1, 8-) = Cells(i + 1, 9) Then
.Value = Cells(i + 1, 4)
'2b.> 2 No 1 Co voi Co truoc
ElseIf Dk2 And Ci8 + Cells(i + 1, 8-) = Cells(i - 1, 9) Then
.Value = Cells(i - 1, 4)
ElseIf Dk2 And Ci8 + Cells(i - 1, 8-) = Cells(i - 2, 9) Then
.Value = Cells(i - 2, 4)
'3a.> 3 No 1 Co voi No truoc
ElseIf DK1 And Ci8 + Cells(i + 1, 8-) + Cells(i + 2, 8-) = Cells(i + 3, 9) Then
.Value = Cells(i + 3, 4)
ElseIf DK1 And Ci8 + Cells(i - 1, 8-) + Cells(i + 1, 8-) = Cells(i + 2, 9) Then
.Value = Cells(i + 2, 4)
ElseIf DK1 And Ci8 + Cells(i - 1, 8-) + Cells(i - 2, 8-) = Cells(i + 1, 9) Then
.Value = Cells(i + 1, 4)
'3b.> 3 No 1 Co voi Co truoc
ElseIf DK1 And Ci8 + Cells(i + 1, 8-) + Cells(i + 2, 8-) = Cells(i - 1, 9) Then
.Value = Cells(i - 1, 4)
ElseIf DK1 And Ci8 + Cells(i + 1, 8-) + Cells(i - 1, 8-) = Cells(i - 2, 9) Then
.Value = Cells(i - 2, 4)
ElseIf Dk2 And Ci8 + Cells(i - 1, 8-) + Cells(i - 2, 8-) = Cells(i - 3, 9) Then
.Value = Cells(i - 3, 4)
'Tu truong hop 4a tro ve sau thuat toan se khac, do la dao chieu giua No va Co
'4a.> 1 No 2 Co voi No truoc
ElseIf Dk3 And Cells(i + 1, 9) <> 0 And Ci9 + Cells(i + 1, 9) = Cells(i - 1, 8-) Then
.Value = .Offset(, -1)
.Offset(, -1) = .Offset(-1, -1)
ElseIf Dk4 And Ci9 + Cells(i - 1, 9) = Cells(i - 2, 8-) Then
.Value = .Offset(, -1)
.Offset(, -1) = .Offset(-2, -1)
'4b.> 1 No 2 Co voi Co truoc
ElseIf Dk3 And Cells(i + 1, 9) <> 0 And Ci9 + Cells(i + 1, 9) = Cells(i + 2, 8-) Then
.Value = .Offset(, -1)
.Offset(, -1) = .Offset(2, -1)
ElseIf Dk3 And Cells(i - 1, 9) <> 0 And Ci9 + Cells(i - 1, 9) = Cells(i + 1, 8-) Then
.Value = .Offset(, -1)
.Offset(, -1) = .Offset(1, -1)
'5a.> 1 No 3 Co voi No truoc
ElseIf Dk3 And Cells(i + 1, 9) <> 0 And Ci9 + Cells(i + 1, 9) + Cells(i + 2, 9) = Cells(i - 1, 8-) Then
.Value = .Offset(, -1)
.Offset(, -1) = .Offset(-1, -1)
ElseIf Dk3 And Cells(i + 1, 9) <> 0 And Ci9 + Cells(i + 1, 9) + Cells(i - 1, 9) = Cells(i - 2, 8-) Then
.Value = .Offset(, -1)
.Offset(, -1) = .Offset(-2, -1)
ElseIf Dk4 And Cells(i - 1, 9) <> 0 And Ci9 + Cells(i - 1, 9) + Cells(i - 2, 9) = Cells(i - 3, 8-) Then
.Value = .Offset(, -1)
.Offset(, -1) = .Offset(-3, -1)
'5b.> 1 No 3 Co voi Co truoc
ElseIf Dk3 And Cells(i + 1, 9) <> 0 And Ci9 + Cells(i + 1, 9) + Cells(i + 2, 9) = Cells(i + 3, 8-) Then
.Value = .Offset(, -1)
.Offset(, -1) = .Offset(3, -1)
ElseIf Dk3 And Cells(i + 1, 9) <> 0 And Ci9 + Cells(i + 1, 9) + Cells(i - 1, 9) = Cells(i + 2, 8-) Then
.Value = .Offset(, -1)
.Offset(, -1) = .Offset(2, -1)
ElseIf Dk3 And Cells(i - 1, 9) <> 0 And Ci9 + Cells(i - 1, 9) + Cells(i - 2, 9) = Cells(i + 1, 8-) Then
.Value = .Offset(, -1)
.Offset(, -1) = .Offset(1, -1)
End If
'-------------------------------------------------------------------------------------
If .Value <> "" And .Offset(, -1) <> "" Then .Offset(, 1).Value = Ci8 + Ci9
End With
Next i
Set Ci8 = Nothing: Set Ci9 = Nothing
DelRow ' Huy dong lenh nay de xem va sua chua cac thuat toan o tren
[A2] = Timer - t
[A6:G6].AutoFilter
Application.ScreenUpdating = True
End Sub
'================================================= ============================================
Sub DelRow()
Dim Cell As Range, Rng As Range, r As Long
Set Rng = Range("F7:F" & [D65536].End(xlUp).Row)
For Each Cell In Rng
Cell.Offset(, 2).Value = Cell.Row
If Cell.Value = 0 Then Cell.EntireRow.Clear
Next
Range("A7:H65536").Sort key1:=[H7], order1:=xlAscending
[D765536].HorizontalAlignment = xlCenter
[E7:E65536].HorizontalAlignment = xlCenter
[G7:G65536].HorizontalAlignment = xlCenter
[F7:F65536].NumberFormat = "#,##0"
Columns("H:I").Clear
Set Rng = Nothing: Set Cell = Nothing
End Sub
'================================================= ============================================
Sub test()
Dim ChungtuData As Range, SotienData As Range, ChungtuConvert As Range, SotienConvert As Range
Dim Cell As Range, t As Double
Application.ScreenUpdating = False
t = Timer
[A265536].Clear
[B1] = "Chung tu"
With Sheets("DATA")
Set ChungtuData = .Range("A7:A" & .[A65536].End(xlUp).Row)
Set SotienData = ChungtuData.Offset(, 4)
End With
ChungtuData.Copy Destination:=[B2]
[B1:B65536].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[A1], Unique:=True
[B2:B65536].Clear
[B1] = "DATA"
With Sheets("Convert")
Set ChungtuConvert = .Range("A7:A" & .[A65536].End(xlUp).Row)
Set SotienConvert = ChungtuConvert.Offset(, 5)
End With
For Each Cell In Range("A2:A" & [A65536].End(xlUp).Row)
If Cell <> "" Then
Cell.Offset(, 1) = WorksheetFunction.SumIf(ChungtuData, Cell, SotienData)
Cell.Offset(, 2) = WorksheetFunction.SumIf(ChungtuConvert, Cell, SotienConvert)
Cell.Offset(, 3) = Cell.Offset(, 1) - Cell.Offset(, 2)
End If
Next
[E1] = Timer - t
[A11].AutoFilter
Set ChungtuData = Nothing: Set SotienData = Nothing
Set ChungtuConvert = Nothing: Set SotienConvert = Nothing
Application.ScreenUpdating = True
End Sub
'================================================= =============================================
Sub Taosocai()
Dim Cell As Range, r As Long, t As Double, DK1 As Boolean, Ngay1 As Boolean, Ngay2 As Boolean
Application.ScreenUpdating = False
t = Timer: [A7:G65536].ClearContents: r = 7
If Not IsDate([B2]) Or Not IsDate([B3]) Then Exit Sub
With Sheets("Convert")
For Each Cell In .Range("A7:A" & .[A65536].End(xlUp).Row)
If Cell.Offset(, 1).Row = 5 Then MsgBox "Sheet Convert chua co du lieu!": Exit Sub
If Not IsDate(Cell.Offset(, 1)) Then MsgBox "Gia tri ngay trong Cell : Convert!" & Cell.Offset(, 1).Address & " Khong dung": Exit Sub
Ngay1 = DateValue(Cell.Offset(, 1)) >= DateValue([B2])
Ngay2 = DateValue(Cell.Offset(, 1)) <= DateValue([B3])
DK1 = InStr(1, Cell.Offset(, 3), [F3], 1) = 1
If DK1 Or InStr(1, Cell.Offset(, 4), [F3], 1) = 1 Then
Select Case [C3]
Case 0
Cells(r, 1) = Cell
Cells(r, 2) = Cell.Offset(, 1)
Cells(r, 3) = Cell.Offset(, 2)
If DK1 Then
Cells(r, 4) = Cell.Offset(, 4)
Cells(r, 5) = Cell.Offset(, 5)
Else
Cells(r, 4) = Cell.Offset(, 3)
Cells(r, 6) = Cell.Offset(, 5)
End If
Cells(r, 7) = Cell.Offset(, 6)
r = r + 1
Case 1
If Ngay1 * Ngay2 = 1 Then
Cells(r, 1) = Cell
Cells(r, 2) = Cell.Offset(, 1)
Cells(r, 3) = Cell.Offset(, 2)
If DK1 Then
Cells(r, 4) = Cell.Offset(, 4)
Cells(r, 5) = Cell.Offset(, 5)
Else
Cells(r, 4) = Cell.Offset(, 3)
Cells(r, 6) = Cell.Offset(, 5)
End If
Cells(r, 7) = Cell.Offset(, 6)
r = r + 1
End If
End Select
Cells(r, 4).HorizontalAlignment = xlCenter
Cells(r, 5).NumberFormat = "#,##0"
Cells(r, 6).NumberFormat = "#,##0"
Cells(r, 7).HorizontalAlignment = xlCenter
End If
Next
End With
[C3] = 0
[G3] = Timer - t
[A6:G6].AutoFilter
Application.ScreenUpdating = True
End Sub

[hunghk]

Cảm ơn mọi người đã ghé đọc.
Em tìm ra lý do vì sao lệch số rồi. Vì Code chưa có trường hợp hạch toán của công ty em. Chính là do công ty hạch toán ngược nên không có
Vẫn mong chờ Code hoàn chỉnh ạ.
Thanks all!