Viết Macro in sổ cái (1 người xem)

  • Thread starter Thread starter Thien
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Thien

Thien

Thành viên thường trực
Tham gia
23/6/06
Bài viết
352
Được thích
113
Thân Chào cả nhà.

Mình nhờ viết giúp mình macro Chỉ in những tài khoản có số dư hoặc số phát sinh (những TK không có số dư & số phát sinh thì không được in).

Mong nhận được sự giúp đỡ.
Cảm ơn.
 

File đính kèm

Bạn tham khảo file gửi kèm, tôi mới làm tạm chuyển số liệu, chưa định dạng kẻ khung, cộng cuối và phần kí.
Nhập tài khoản cần in vào D4.
 

File đính kèm

File của bạn nên đưa thêm DMTK, để lấy sổ cái theo dmtk (cấp 2 hay cấp 3).
Nên bổ sung thêm lấy sổ các theo ngày, từ ngày -> ngày.
Bạn thử áp dụng lọc dữ liệu bằng advance filter (bài của Kelvin), khá hay.
Hay là nghiên cứu file baocaoketoan của Mr OkeBab, very tuyệt.
 
Các bác không hiểu ý mình rùi.
File của mình hiện tại khi muốn in sổ cái của TK nào thì chọn số TK rùi phải chọn Chọn Nonblanks sau khi chọn mã tài khoản tạI ô D2 để in ra giấy.
Nếu có nhiều TK phát sinh thì thao tác này được lặp lại nhiều lần. Nay mình muốn nhờ viết dủm 1 cái macro làm việc đó.
Nếu in ra từng sheet, tên mỗi sheet là số TK có số liệu phát sinh.

Đây là bài toán thật mình đang làm. Rất mong nhận được sự hỗ trợ từ GPE.

PS: Mr BeBe đâu rùi.

Cảm ơn nhiều.
 
Bạn xem thử có đúng ý bạn không? Và bỏ bớt.
Tham khảo file của Mr Be ...
Hãy down file ở bài 7, file này sai, sorry.
 

File đính kèm

Lần chỉnh sửa cuối:
Thien đã viết:
Các bác không hiểu ý mình rùi.
File của mình hiện tại khi muốn in sổ cái của TK nào thì chọn số TK rùi phải chọn Chọn Nonblanks sau khi chọn mã tài khoản tạI ô D2 để in ra giấy.
Nếu có nhiều TK phát sinh thì thao tác này được lặp lại nhiều lần. Nay mình muốn nhờ viết dủm 1 cái macro làm việc đó.
Nếu in ra từng sheet, tên mỗi sheet là số TK có số liệu phát sinh.

Đây là bài toán thật mình đang làm. Rất mong nhận được sự hỗ trợ từ GPE.

PS: Mr BeBe đâu rùi.

Cảm ơn nhiều.
Nhấp chuột vào đây để mở rộng...
Vì Data của bạn quá lộn xộn nên không muốn làm theo Advance Filter. Thôi thì dùng vòng lặp vậy.

Định làm theo kiểu chọn lựa in chi tiết hay tổng hợp nữa, nhưng lười quá nên thôi.

Xem rồi cho ý kiến nhé.

Thân!
 

File đính kèm

Bổ sung lại file kèm, có edit cho print và tạo sh
Do không có dmtk nên làm tạm vài TK, bạn nên xem sh dmtk => lấy những tk có PS.
 

File đính kèm

Cảm ơn BeBe & Thunghi nhiều lắm.
Nhưng có điều giữ nguyên cấu trúc file của mình có được không.

Rất mong nhận được sự giúp đỡ.

Chân thành cảm ơn
 

File đính kèm

Thien đã viết:
Cảm ơn BeBe & Thunghi nhiều lắm.
Nhưng có điều giữ nguyên cấu trúc file của mình có được không.

Rất mong nhận được sự giúp đỡ.

Chân thành cảm ơn
Nhấp chuột vào đây để mở rộng...

Thì Format File của bạn vẫn giữ nguyên đấy chứ. Chẳng qua là File của bạn làm = công thức, của tụi mình chạy = VBA. Hai cái đó sẽ có những cái khác nhau.

Khi làm bằng công thức thì bạn cần phải có những cột phụ . . . , còn khi làm = VBA thì không cần. Vì thế việc có cột phụ hay không có cột phụ là không quan trọng. (thích thì bạn xóa, còn nếu không để đó cũng chẳng sao, chỉ hơi nặng máy chút thôi)

Mục đích cuối cùng là in được sổ cái tự động, in từng sổ hoặc in tất cả tài khoản có phát sinh, mình cho chọn cả từ ngày đến ngày để dễ cho bạn thôi. Không thích thì chọn từ đầu năm đến cuối năm thôi.
Để đạt được điều này thì mỗi cách làm (công thức - VBA) sẽ có những cách khác nhau.

Tất nhiên VBA có thể làm như công thức (thay đổi TK, sau đó chọn lại Auto Filter nhưng như thế thật là buồn cười vì khác nào mua xe máy về mà cứ bắt chạy tốc độ xe đạp, cái gì cũng phải có cái tối ưu của nó), còn nếu cứ muốn như công thức thì thôi .............. để công thức luôn cho xong.

Thân!
 
Nhân cơ hội này mình học thêm 1 vài điều. Làm theo ý bạn, không sửa cái gì. Có thêm vài name. Nhớ xem qua sh dmtk, =>những cái đã in.
Cám ơn thì nhấn Thanks nhé, bao nhiêu sh bao nhiêu lần.
Máy cái này học từ Mr OkeBab cả.
 

File đính kèm

Dear ThuNghi.
Mình cảm ơn bạn, bạn làm đúng ý mình rùi, chỉ có điều có cách nào không cần xem ở chế độ PrintPreview không vì như vậy mắc công nhấn close quá.
Cho mình biết bạn thêm name gì vậy? (Socai,.....)

Dear Mr BeBe
Chắc doanh số tháng này thấp lắm hả, sao giữ quá vậy nè. Mình dở VBA, nên nếu ứng dụng code của bác vào file của mình thì mình làm không được. Bạn thông cảm nhen.

Thân chào.
 
À, hiểu rồi, có nghĩa là khi chạy xong thì sẽ tạo ra các Sheet tương ứng với các TK phát sinh phải không ??

Không hiểu lắm, mình lại làm theo kiểu là in luôn ra các sổ cái này, không chuyển số liệu sang sheet tương ứng.

Mà tại sao lại phải chuyển sang sheet khác nhỉ, ta chỉ cần dùng 1 mẫu, sau đó sẽ in luôn ra tất cả (hoặc 1 TK) có phải là tiện không nhỉ (như File của mình)?? Chứ nếu có 40 TK có phát sinh, chắc phải tạo 40 sheet quá.

Thân!

P/S : Thu Nghi làm khá hay đó.
 
Tìm trong code có dòng sau thì xóa đi
ActiveWindow.SelectedSheets.PrintPreview
 
Các bác cho hỏi thêm.
Trong trường hợp muốn in toàn bộ sổ cái các TK có số PS sang workbook mới thì chỉnh code làm sao nhì?.(hiện tại là tạo ra ngay tại sheet đang mở).

Thân chào.
 
Theo tôi bạn làm xong, chọn hết sh cần chuyển move một cái là có ngay sh mới. (Nên làm code theo hướng này)
Theo yêu cầu của bạn tôi làm thử (học mà), hơi chậm. Tạo 1 file tên socai chung folder, bạn có thể đổi tên. Chép 2 code này vào lại file insocai
Sub TaoNhieuSC()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayAlerts = False
End With
Dim i As Integer, Rows As Integer

S09.Visible = xlSheetVisible
Rows = S99.Cells(2, 3).Value
For i = 1 To Rows
With Application
.Calculation = xlCalculationAutomatic
End With
S03.Range("D2").Value = Range("Dmtk").Cells(i, 1).Value
With Application
.Calculation = xlCalculationManual
End With
'mo file socai cung folder
Workbooks.Open Filename:=ThisWorkbook.Path & "\socai.xls"
Call TaoSoCai
Next i
S03.Select
Selection.AutoFilter Field:=7
S09.Visible = xlSheetHidden
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
End With
S03.Select
Range("d2").Select
End Sub
Nhấp chuột vào đây để mở rộng...

Sub TaoSoCai()
'Xoa tmp
Windows("insocai.xls").Activate
S09.Select
Cells.Select
Selection.ClearContents
Selection.ClearFormats
'copy socai va dan vao tmp
S03.Select
Selection.AutoFilter Field:=7, Criteria1:="<>"
Range("Socai").Select
Selection.Copy
S09.Select
Range("a1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'tao so moi & preview
S09.Copy After:=Sheets(2)
Sheets("tmp (2)").Select
'mosang va dat ten
Sheets("tmp (2)").Move Before:=Workbooks("socai.xls").Sheets(1)
Windows("socai.xls").Activate
Sheets("tmp (2)").Name = Sheets("tmp (2)").Range("D2").Value
ActiveWorkbook.Save
ActiveWindow.Close
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn xem thử thế nào.
 
Dear thunghi!.

Cảm ơn đã giúp mình.
Cho hỏi 1 chút sao không tự tạo ra file socai.xls mà mình phải tạo file socai.xls trước khi chạy code nhỉ?. Bạn khắc phục được không?.

Thân chào
 
Chạy thêm code này trước, dùng sự kiện open
Sub TaoWB()
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\111111.xls"
ActiveWindow.Close
End Sub
 
Cho mình hỏi thêm.
Mình muốn đặt name từ list (mình kiếm code trong điễn đàn không thấy) như sau:
CDPS =CDPS!$A$6:$J$129
Code =CDPS!$I$6:$I$129
DMTK =OFFSET(DMTK!$B$2:$B$101,0,0,COUNTA(DMTK!$B$2:$B$101),1)
SoCai ='So cai'!$A$1:$F$1014

cột 1 là CDPS
cột 2 là =CDPS!$A$6:$J$129

code sẽ dò từng dòng trong sheet chứa list muốn tạo name & tạo ra name

Thân chào
 
Public Sub Add_name()
Dim i As Long 'NVSON
For i = 1 To Range("rngName").Rows.Count
ActiveWorkbook.Names.Add Name:=Range("rngName").Cells(i, 1).Value, RefersTo:="=" & Range("rngReplace").Cells(i, 1).Value
Next i
End Sub
Public Sub ThayThe()
On Error Resume Next 'NVSON
Dim i As Long, StrText As String
Dim KQ
For i = 1 To ActiveWorkbook.Names.Count
Err.Clear
KQ = WorksheetFunction.Match(ActiveWorkbook.Names(i, 1, 1).NameLocal, Range("rngName"), 0)
If Err.Number = 0 Then
StrText = WorksheetFunction.Index(Range("rngReplace"), KQ, 1)
ActiveWorkbook.Names.Add Name:=ActiveWorkbook.Names(i, 1, 1).NameLocal, RefersTo:="=" & StrText
End If
Next i
End Sub
Sub Link_Paste_Names()
On Error GoTo thoat 'NVSON
Dim row1 As Integer, col1 As Integer
Dim i As Integer
row1 = ActiveCell.Row
col1 = ActiveCell.Column
For i = 1 To ActiveWorkbook.Names.Count
Cells(row1 + i - 1, col1) = ActiveWorkbook.Names(i, 1, 1).NameLocal
Cells(row1 + i - 1, col1 + 1) = Mid(ActiveWorkbook.Names(i, 1, 1).RefersTo, 2)
Cells(row1 + i - 1, col1 + 1).Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=ActiveWorkbook.Names(i, 1, 1).RefersTo
Next i
thoat:
End Sub
Nhấp chuột vào đây để mở rộng...
Cái này của NVSon
 
chẳn hiểu sao lại báo lỗi dòng này.

ActiveWorkbook.Names.Add Name:=Range("rngName").Cells(i, 1).Value, RefersTo:="=" & Range("rngReplace").Cells(i, 1).Value

Thân chào
 
Public Sub Add_name()
Dim i As Long 'NVSON
For i = 1 To Range("rngName").Rows.Count
ActiveWorkbook.Names.Add Name:=Range("rngName").Cells(i, 1).Value, RefersTo:="=" & Range("rngReplace").Cells(i, 1).Value
Next i
End Sub
Nhấp chuột vào đây để mở rộng...
Do tôi đặt rngName là offset()
Bạn thay câu sau
For i = 1 To Range("rngName").Rows.Count
thành
For i = 1 To WorksheetFunction.CountA(Range("rngName")) là OK
rngName: cột tên name
rngReplace: cột tham chiếu
 
Buồn quá bạn ơi. Làm không được rùi

TC
 
Lần chỉnh sửa cuối:
Phải có sh dmtk, cdps, socai nó mới tìm mà đặt chớ. Làm thêm hàm kiểm tra sh name thì no need.
Bạn theo thử file sau.
 

File đính kèm

Dear Thunghi.

Mình làm theo hướng dẫn của file Anh Hiếu để tạo sổ cái bằng VBA (không dùng công thức như trước đây).
Nhưng mình muốn từ sổ cái này sẽ tạo ra các sheet chứa từng TK như file của Thunghi thì lảm hoài không được.
Bạn xem giúp mình nhen.

TC.
 

File đính kèm

Bạn nghiên cứu thử, sẽ duyệt qua từng cell của sh dmtk (tk cần lấy sổ cái) code taonhsocai.
Gán giá trị vào Cells( ) trong sổ cái, mỗi lần gán thì chạy code tạo sổ cái và copy.
Làm xong nhớ cho tôi file nguồn (đầy đủ) để làm báo cáo nhé.
Bạn đã nghiên cứu file của Mr Hiếu rồi sao không làm file của 1 năm luốn. Chỉ cần thêm cột ngày.
 
He He bạn không chịu coi file của mình rùi.
Mình sửa code đủ kiểu mà chẳng được gì
 
1/ Khi bạn tạo xong 1 sổ cái, hide những dòng trống => copy socai -> sh tmp sẽ luôn bị hide theo sh sổ cái đầu. Phần cuối của sổ cái Ngày... giám đốc nên đặt name là footer, sau khi code tạo sổ cái xong thì chép vào cells(i+3,1), i là dòng cuối. Như vậy độ dài các sổ cái sẽ là những dòng thực tế có dữ liệu => file nhẹ hơn.
2/ Dùng shape để thực hiện code, khi copy socai sẽ copy luôn => nặng. Nên dùng command button.
3/ Name DMTK nên sửa lại như sau
=OFFSET(DMTK!$B$2:$B$101,0,0,COUNTIF(DMTK!$B$2:$B$101,">0"),1)
4/ Vừa rồi làm file insocai này tôi có thấy tôi sai 1 cái gì mà hiện tại quên rồi.
5/ Bỏ sự kiện change no need
Tôi sẽ hòan thành lại và thêm vào copy những sổ cái sang wb khác.
Bạn nghiên cứu thử nhé. Sẽ làm cho bạn ASAP.
 
Tôi sửa sơ file insocai và có thêm tạo new wb chứa những sổ cái. Trước khi bạn tạo new WB nhớ phảo tạo sổ cái.
Đang tìm code tìm sự tồn tại sh để gắn vào.
Chưa test chi tiết. Bạn test hộ nhé.
 

File đính kèm

Dear Thunghi.

Cảm ơn sự nhiệt tình giúp đỡ của bạn. Mình có vài câu hỏi nhờ giải đáp:
- Code sổ cái mình copy từ file Mr Hiếu sang file của mình thì trong marco name không có tên SoCai mà có tên Module1.SoCai. Điều này mình gặp phải rất nhiều, ngay cả khi export module từ file này import sang file khác nếu giữ nguyên tên module thì không có gì còn nếu đặt lại tên khác thì bị như trên.
- Trong file Insocai-V2 của bạn cũng như trong file của mình có 1 điều mình không biết cách chỉnh là tại ô E8 & F8 mình không muốn tính bằng VBA, mà muốn giữ nguyên E8 =IF($D$2="","",VLOOKUP($D$2,CDPS,6,0)) và F8=IF($D$2="","",VLOOKUP($D$2,CDPS,6,0)). Một điều vô lý là trong code của Mr Hiếu có đặt VBA cho cả 02 ô này nhưng khi chạy code thì chỉ ô E8 bị thôi, còn ô F8 vẫn còn công thức. Điều này cũng làm cho các sổ cái được tạo ra trên từng sheet bị tính toán sai ngay tại ô E8.

Bạn xem hộ & giải thích giúp mình.

Cảm ơn nhiều.

Thân chào (TC.).


PS: Mr Hiếu sao vẫn không giúp mình giải đáp thắc mắc file mình gửi qua mail nhỉ?.
 
1/ Do code socai trùng tên với name socai nên có tình trạng Module1.SoCai, sửa tên code socai thành socaict thì OK.
2/E8 =IF($D$2="","",VLOOKUP($D$2,CDPS,6,0)) F8=IF($D$2="","",VLOOKUP($D$2,CDPS,6,0))
F8 thì công thức khá OK nhưng E8 số 6 phải là 5.
Nhưng đây là file tạo socai theo tk và theo ngày nên sumif theo sh CDPS thì không có nghĩa, cdps của tháng 6...Nếu có dùng thì dùng sumproduct, nhưng cũng không được vì cột E, F, L của Sh PhatSinh không = nhau.=>Dùng VBA và sd đầu kỳ, xem lại. SD cuối thì dùng hàm max thì OK
3/
If Left$(TKNo, m) = TK Then ' No
If TKNo.Offset(0, -2).Value < S01.Range("C4").Value Then ' Ngay nho hon
i = i + 1
'S01.Range("E8").Value = S01.Range("E8").Value + TKNo.Offset(0, 7).Value
Else ' Phat Sinh
S01.Range("E8").Value = S01.Range("E8").Value + TKNo.Offset(0, 7).Value
'i = i + 1
S01.Range("A" & i) = TKNo.Offset(0, -3)
S01.Range("B" & i) = TKNo.Offset(0, -2)
S01.Range("C" & i) = TKNo.Offset(0, -1)
S01.Range("D" & i) = TKNo.Offset(0, 1)
S01.Range("E" & i) = TKNo.Offset(0, 7)
End If
i = i + 1
Nhấp chuột vào đây để mở rộng...
Tôi có sửa lại phần bold, (xin phép Mr Hiếu), lý do if ngày > hơn thì skip (i=i+1) chớ không S01.Range("E8").Value = S01.Range("E8").Value + TKNo.Offset(0, 7).Value (cộng dồn E8). Ngược lại nếu ngày >= ngày đầu thì như S01.Range("E8").Value = S01.Range("E8").Value + TKNo.Offset(0, 7).Value mới OK. Do làm vòng lặp nên sửa lại lâu hơn làm mới. Bạn tham khảo MR Hiếu cho rõ hơn.
4/ Thêm một số code kiểm tra nếu chưa tạo sổ cái chi tiết thì phải tạo rồi mới tạo new WB.
5/ Them một số dòng chuyển DL của tmp sang giá trị và bỏ validation => New WB không còn link.
Tóm lại dl bài này phải coi lại số dư đầu kỳ (ngày < ngày đầu.)
Chúc bạn thành công.
 

File đính kèm

Thien đã viết:
Dear Thunghi.

Cảm ơn sự nhiệt tình giúp đỡ của bạn. Mình có vài câu hỏi nhờ giải đáp:
- Code sổ cái mình copy từ file Mr Hiếu sang file của mình thì trong marco name không có tên SoCai mà có tên Module1.SoCai. Điều này mình gặp phải rất nhiều, ngay cả khi export module từ file này import sang file khác nếu giữ nguyên tên module thì không có gì còn nếu đặt lại tên khác thì bị như trên.
- Trong file Insocai-V2 của bạn cũng như trong file của mình có 1 điều mình không biết cách chỉnh là tại ô E8 & F8 mình không muốn tính bằng VBA, mà muốn giữ nguyên E8 =IF($D$2="","",VLOOKUP($D$2,CDPS,6,0)) và F8=IF($D$2="","",VLOOKUP($D$2,CDPS,6,0)). Một điều vô lý là trong code của Mr Hiếu có đặt VBA cho cả 02 ô này nhưng khi chạy code thì chỉ ô E8 bị thôi, còn ô F8 vẫn còn công thức. Điều này cũng làm cho các sổ cái được tạo ra trên từng sheet bị tính toán sai ngay tại ô E8.

Bạn xem hộ & giải thích giúp mình.

Cảm ơn nhiều.

Thân chào (TC.).


PS: Mr Hiếu sao vẫn không giúp mình giải đáp thắc mắc file mình gửi qua mail nhỉ?.
Nhấp chuột vào đây để mở rộng...

E8 và F8 : Phát sinh lũy kế kỳ trước. Hoàn toàn không có công thức
Vì vậy chỉ khi kỳ trước có phát sinh, thì mới có nó được

Code của mình là :
Sổ cái
  • Duyệt qua tất cả DATA, tìm TK thỏa mãn
  • Chú nào có ngày phát sinh nhỏ hơn kỳ được chọn (C4-D4) thì cho vào E8 và F8
  • Chú nào có phát sinh lớn hơn kỳ được chọn (C4-D4) thì bye
  • Chú nào trong kỳ thì lọc lấy các thông tin cần thiết, cho vào bảng
  • Cộng tất cả phát sinh trong kỳ lại
  • Cộng phát sinh lũy kế đến kỳ
  • Tính số dư cuối kỳ
In Tất cả
  • Xét Sổ cái của từng TK
  • Nếu có số dư đầu kỳ, hoặc phát sinh trong kỳ, hoặc số dư cuối kỳ thì in ra
Do cách làm của bạn khác của mình (bạn muốn từng TK trên từng sheet) nên mình không làm theo cách của bạn được (vì rất mất công và không hợp lý (theo mình)).
Và vấn đề này ThuNghi đang đi theo hướng của bạn đấy.

(File trên đã được sửa lỗi khi cộng sai Số phát sinh lũy kế đến kỳ, mình đã up lại)

In Sổ Cái

Thân!
 
Dear Thunghi
Mới test sơ qua thấy lỗi rùi.
Để xem kỹ lại rùi mình thống kê lỗi cho.
Sơ qua thấy 2 lỗi rùi:
1/ Code đang chạy báo lỗi S01.Range("E8").Value = S01.Range("E8").Value + TKNo.Offset(0, 7).Value.
2/ Tự nhiên E7 &F7 + E9 & F9 bị mất công thức vậy nhỉ. (bị #VALUE! tại TK 4212).
3/ Từ ô E7:F9 xin đừng sữa công thức trong vùng này.


Vài dòng gửi bạn.

TC.

PS: cảm ơn Mr Hiếu để mình test thử. Còn file mình gửi qua mail hướng dẫn mình với. (Em có lý do của mình nên mới nhờ copy từng TK sang từng sheet.)
 
Lần chỉnh sửa cuối:
Bác này chơi tôi thiệt
L994=IF(SUM(L983:L985)>SUM(L962:L980),SUM(L983:L985)-SUM(L962:L980)," ")
Thay bằng
L994=IF(SUM(L983:L985)>SUM(L962:L980),SUM(L983:L985)-SUM(L962:L980),0)
 
OK, sẽ cố gắng theo ý "lãnh đạn"

Thân!
 
ThuNghi đã viết:
Bác này chơi tôi thiệt
L994=IF(SUM(L983:L985)>SUM(L962:L980),SUM(L983:L985)-SUM(L962:L980)," ")
Thay bằng
L994=IF(SUM(L983:L985)>SUM(L962:L980),SUM(L983:L985)-SUM(L962:L980),0)
Nhấp chuột vào đây để mở rộng...

Ở đâu vậy?
 
L994 ở sh PhatSinh
Khai báo thêm trong code SocaiCt
Dim st as long
Thay những câu sau vào code SocaiCT
Else ' Phat Sinh
ST = IIf(WorksheetFunction.IsText(TKNo.Offset(0, 7).Value), 0, TKNo.Offset(0, 7).Value)
S01.Range("F8").Value = S01.Range("F8").Value + ST 'TKNo.Offset(0, 7).Value
Nhấp chuột vào đây để mở rộng...
ST = IIf(WorksheetFunction.IsText(TKNo.Offset(0, 7).Value), 0, TKNo.Offset(0, 7).Value)
S01.Range("E8").Value = S01.Range("E8").Value + ST
Nhấp chuột vào đây để mở rộng...
ie nếu TKNo.Offset(0, 7).Value là text lấy là 0.
 
Dear Thunghi.
Cảm ơn đã giúp đỡ.
Mình làm được rùi. Rất hay.

Thân chào.
 
Sao o nhấn Thanks nhỉ
 
He He mình thank bạn 1.000 lần nhen.
Cho hỏi thêm 1 chút. trong trường hợp muốn in ra giấy luôn thì chỉnh code chỗ nào.

TC.
 
1/Thêm vào sub SocaiCT gần cuối sub
ActiveWindow.SelectedSheets.PrintPreview
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Set TKNo = Nothing
With Application
....
Nhấp chuột vào đây để mở rộng...

Nếu muốn không preview thì bỏ dòng ActiveWindow.SelectedSheets.PrintPreview
2/ Tại Sub TaonhieuSC
Thay
Call TaoSoCai
là
Call SoCaiCT
Theo tôi bạn nên tạo thêm 1 code và 1 command nếu bạn có đổi ý.
 
Đúng rùi mình muốn thêm 1 command nữa khi muốn in ra giấy luôn.
Các Bạn xem có gộp code lại với nhau được không (Mong Thunghi cho phép post code lên nhen).
-
Mã: 
Option Explicit
Sub InNhieuSC()
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
Dim i As Integer, Rows As Integer
'S09.Visible = xlSheetVisible
Rows = S99.Cells(2, 3).Value
    For i = 1 To Rows
        S01.Range("D2").Value = Range("Dmtk").Cells(i, 1).Value
    Call InSoCaiCT
    Next i
    S09.Select
    Cells.ClearContents
    Cells.ClearFormats
    ' S09.Visible = xlSheetHidden
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
S01.Select
Range("d2").Select
End Sub

Sub InSoCaiCT()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    S01.Range("A1").Value = "=TEN"
    S01.Range("A1").Value = S01.Range("A1").Value
    S01.Range("A2").Value = "=MST"
    S01.Range("A2").Value = S01.Range("A2").Value
    S01.Range("A3").Value = "=DC"
    S01.Range("A3").Value = S01.Range("A3").Value
    Selection.Merge True
    Range("A1:B3").Select
    Selection.Merge True
    
    S01.Range("D1009").Value = "=NGAY"
    S01.Range("D1009").Value = S01.Range("D1009").Value
    Selection.Merge True
    Range("D1015:F1009").Select
    Selection.Merge True
    
    S01.Range("C1015").Value = "=KTT"
    S01.Range("C1015").Value = S01.Range("C1015").Value
    S01.Range("D1015").Value = "=GIAMDOC"
    S01.Range("D1015").Value = S01.Range("D1015").Value
    Selection.Merge True
    Range("D1015:F1015").Select
    Selection.Merge True
      
    Dim i, HC, m As Long
    Dim TKNo As Range
    Dim TK As String
    S01.Range("E8:F8").ClearContents
    TK = Left$(S01.Range("D2"), 10)
    m = Len(S01.Range("D2"))
    HC = S00.Range("E65000").End(xlUp).Row
    i = 12
    S01.Range("A12:F1006, E1007:F1007").ClearContents ' Xoa temp
    S01.Range("A12:F1006").EntireRow.Hidden = False
    
    For Each TKNo In S00.Range("E5:E" & HC)
        If TKNo.Offset(0, -2) <= S01.Range("D4").Value And Len(TKNo) > 2 Then
            If Left$(TKNo, m) = TK Then ' No
                If TKNo.Offset(0, -2).Value < S01.Range("C4").Value Then ' Ngay nho hon
                i = i + 1
                'S01.Range("E8").Value = S01.Range("E8").Value + TKNo.Offset(0, 7).Value
                Else ' Phat Sinh
                Dim st As Long
                st = IIf(WorksheetFunction.IsText(TKNo.Offset(0, 7).Value), 0, TKNo.Offset(0, 7).Value)
                S01.Range("E8").Value = S01.Range("E8").Value + st
                'TKNo.Offset(0, 7).Value
                'S01.Range("E8").Value = S01.Range("E8").Value + TKNo.Offset(0, 7).Value
                'i = i + 1
                    S01.Range("A" & i) = TKNo.Offset(0, -3)
                    S01.Range("B" & i) = TKNo.Offset(0, -2)
                    S01.Range("C" & i) = TKNo.Offset(0, -1)
                    S01.Range("D" & i) = TKNo.Offset(0, 1)
                    S01.Range("E" & i) = TKNo.Offset(0, 7)
                End If
                i = i + 1
            ElseIf Left$(TKNo.Offset(0, 1), m) = TK Then ' Co
                If TKNo.Offset(0, -2).Value < S01.Range("C4").Value Then ' Ngay nho hon
                'S01.Range("F8").Value = S01.Range("F8").Value + TKNo.Offset(0, 7).Value
                i = i + 1
                Else ' Phat Sinh
                st = IIf(WorksheetFunction.IsText(TKNo.Offset(0, 7).Value), 0, TKNo.Offset(0, 7).Value)
                S01.Range("F8").Value = S01.Range("F8").Value + st
                'S01.Range("F8").Value = S01.Range("F8").Value + TKNo.Offset(0, 7).Value
                    'i = i + 1
                    S01.Range("A" & i) = TKNo.Offset(0, -3)
                    S01.Range("B" & i) = TKNo.Offset(0, -2)
                    S01.Range("C" & i) = TKNo.Offset(0, -1)
                    S01.Range("D" & i) = TKNo
                    S01.Range("F" & i) = TKNo.Offset(0, 7)
                End If
                i = i + 1
            End If
        End If
    Next
    'Stop
    If i > 11 Then
        S01.Range("E1007").Value = WorksheetFunction.Sum(S01.Range("E12:E" & i))
        S01.Range("F1007").Value = WorksheetFunction.Sum(S01.Range("F12:F" & i))
    End If
    If i < 20 Then i = 20
    S01.Range("A" & i + 1 & ":A1006").EntireRow.Hidden = True
    'ActiveWindow.SelectedSheets.PrintPreview
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Set TKNo = Nothing
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Sẽ có 3 nút command: 1 là in ra sheet, 2 là in sang WB khác, 3 là in ra giấy luôn.

TC.
 
Lần chỉnh sửa cuối:
Bạn copy code TaoNhieuSC = TaoNhieuSC_in
Code SoCaiCT =SoCaiCT_in
Thay những điều tôi nói vào TaoNhieuSC_in và SoCaiCT_in
 
Bạn copy tòan bộ code sau vào thay thế, trừ code TaoNewWB
Mã: 
Option Explicit
Sub InNhieuSC()
Dim i As Integer, Rows As Integer
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
Rows = S99.Cells(2, 3).Value
    For i = 1 To Rows
        S01.Range("D2").Value = Range("Dmtk").Cells(i, 1).Value
        Call SoCaiCT
        ActiveWindow.SelectedSheets.PrintPreview
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'Muốn chọn cái nào thì chọn
    Next i
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
S01.Select
Range("d2").Select
End Sub
Sub TaoNhieuSC()
Dim i As Integer, Rows As Integer
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
S09.Visible = xlSheetVisible
Rows = S99.Cells(2, 3).Value
    For i = 1 To Rows
        S01.Range("D2").Value = Range("Dmtk").Cells(i, 1).Value
        Call SoCaiCT
        Call TaoSoCai
    Next i
With S09
    .Cells.ClearContents
    .Cells.ClearFormats
    .Visible = xlSheetHidden
End With
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayAlerts = True
End With
S01.Select
Range("d2").Select
End Sub
Sub TaoSoCai()
'Xoa tmp 'unhide row to paste
With S09
    .Range("A:F").EntireRow.Hidden = False
    .Cells.ClearContents
    .Cells.ClearFormats
End With
'copy socai va dan vao tmp
    S01.Select
    Range("Socai").Select
    Selection.Copy
    S09.Select
    Range("a1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    'gan lai gia tri va xoa validation muc dich tao file chi tiet no link
    S09.Range("e7:F9").Value = S09.Range("e7:F9").Value
    S09.Range("A1:D6").Value = S09.Range("A1:D6").Value
    S09.Range("D2").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    
    Dim i As Long
    'xac dinh dong cuoi co dl
    i = S09.Range("C1006").End(xlUp).Row
    If i < 20 Then i = 20
    'xoa dong trong ->1006 trong sh tmp
    S09.Range("A" & i + 1 & ":A1006").EntireRow.Delete Shift:=xlUp
    'tao so moi & preview
    S09.Copy After:=s98
    Sheets("tmp (2)").Select
    Sheets("tmp (2)").Name = Sheets("tmp (2)").Range("D2").Value
End Sub
Sub SoCaiCT()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    Dim i, HC, M As Long
    Dim TKNo As Range
    Dim TK As String
    Dim ST As Long
    
    S01.Range("E8:F8").ClearContents
    TK = Left$(S01.Range("D2"), 10)
    M = Len(S01.Range("D2"))
    HC = S00.Range("E65000").End(xlUp).Row
    i = 12
    S01.Range("A12:F1006, E1007:F1007").ClearContents ' Xoa temp
    S01.Range("A12:F1006").EntireRow.Hidden = False
    
    For Each TKNo In S00.Range("E5:E" & HC)
        If TKNo.Offset(0, -2) <= S01.Range("D4").Value And Len(TKNo) > 2 Then
            If Left$(TKNo, M) = TK Or Left$(TKNo.Offset(0, 1), M) = TK Then ' No Co =TK
                If TKNo.Offset(0, -2).Value < S01.Range("C4").Value Then ' Ngay nho hon
                    i = i + 1
                Else ' Phat Sinh
                    ST = IIf(WorksheetFunction.IsText(TKNo.Offset(0, 7).Value), 0, TKNo.Offset(0, 7).Value)
                    With S01
                        .Range("A" & i & ":C" & i).Value = Range(TKNo.Offset(0, -3), TKNo.Offset(0, -1)).Value
                    End With
                    'sotien - TKDU
                With S01
                        If Left$(TKNo, M) = TK Then
                            .Range("D" & i) = TKNo.Offset(0, 1)
                            .Range("E8").Value = S01.Range("E8").Value + ST
                            .Range("E" & i) = TKNo.Offset(0, 7)
                        Else
                            .Range("D" & i) = TKNo
                            .Range("F8").Value = S01.Range("F8").Value + ST
                            .Range("F" & i) = TKNo.Offset(0, 7)
                        End If
                    End With
                End If
                i = i + 1
            End If
        End If
    Next
    If i > 11 Then
        S01.Range("E1007").Value = WorksheetFunction.Sum(S01.Range("E12:E" & i))
        S01.Range("F1007").Value = WorksheetFunction.Sum(S01.Range("F12:F" & i))
    End If
    If i < 20 Then i = 20
    S01.Range("A" & i + 1 & ":A1006").EntireRow.Hidden = True
    Set TKNo = Nothing
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub
 
Lần chỉnh sửa cuối:
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

D
Xin giúp.......Kết hợp countifs và Sumproduct để đếm dữ liệu và tính số lượng tổng không trùng lặp với nhiều điều kiện (1 người xem)
Trả lời
11
Đọc
317
dieppk.nb92
D
PhanTuHuong
Nếu diễn đàn GPE đóng cửa? (3 người xem)
    • Thích
    • Yêu thích
Trả lời
16
Đọc
410
PhanTuHuong
PhanTuHuong
HeSanbi
  • Đã giải quyết
WeatherXL - Ứng dụng lấy dữ liệu Thời tiết siêu nhanh (***Đang phát triển lại)
    • Thích
    • Yêu thích
Trả lời
92
Đọc
27K
Maika8008
Maika8008
P
Lỗi hàm VBA phải add-in sau mỗi lần mở file (2 người xem)
Trả lời
5
Đọc
139
phamdinh.huy.aladin@gmail
P
K
Các nút Buttom, Combobox, Textbox bị thay đổi kích thước ... (2 người xem)
Trả lời
4
Đọc
94
ptm0412
ptm0412
D
  • Question Question
Tách dòng tự động theo điều kiện bằng VBA (1 người xem)
    • Cười
Trả lời
14
Đọc
285
ptm0412
ptm0412
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
580
Đọc
82K
pycckuu410
pycckuu410
E
  • Đã giải quyết
VBA code thay thế cho pivot-table lấy top 10, bottom 10
    • Thích
Trả lời
24
Đọc
513
eagle12
E
HeSanbi
Thuật ngữ "Đối chiếu Unicode" quan trọng trong việc xử lý chuỗi ký tự
Trả lời
1
Đọc
145
jonythanht
J
H
tìm kiếm nội dung liên kết giữa cac bảng , cac sheet trong excel (1 người xem)
Trả lời
2
Đọc
117
DeTong
D
N
Công thức trích xuất riêng các ký tự trong chuỗi họ tên (1 người xem)
Trả lời
7
Đọc
142
Ngựa con 2002
N
Q
Nhờ các chị cho em xin công thức đếm bản ghi loại bỏ dữ liệu trùng lặp với nhiều điều kiện
Trả lời
2
Đọc
138
dungpham01
D
huuthang_bd
Cùng xây dựng file Gia Phả
    • Thích
Trả lời
36
Đọc
21K
le_vis
L
D
Công thức tính thuế thu nhập cá nhân mới nhất theo mức 5 bậc
Trả lời
14
Đọc
761
Cúc Hr
C
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Cảm ơn
    • Thích
Trả lời
8
Đọc
2K
PhanTuHuong
PhanTuHuong
D
  • Question Question
IN TỰ ĐỘNG TỪ DỮ LIỆU CÓ SẴN (1 người xem)
Trả lời
14
Đọc
481
duongnhuxuyen
D
V
Biểu diễn số đếm theo hình vẽ từ Shape (1 người xem)
Trả lời
34
Đọc
741
Vũ Hải Sơn
V
T
Xử lý lỗi xuất hiện màu cam khi chọn 1 ô trong excel.
Trả lời
1
Đọc
119
Maika8008
Maika8008
L
  • Question Question
Tạo ComboBox để tìm kiếm tên
Trả lời
4
Đọc
218
HUONGHCKT
H
T
Điên đầu vì Countif
Trả lời
5
Đọc
292
87kilua
87kilua
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom