Dùng VBA để tổng hợp dữ liệu (1 người xem)

  • Thread starter Thread starter kulyvn
  • 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)
K

kulyvn

Thành viên thường trực
Tham gia
3/8/11
Bài viết
283
Được thích
4
Mình cần viết 1 đoạn code để tổng hợp trong file Danh sach.xls với điều kiện như sau:
Nếu [vba.xls]THA!$CN$10:$CN$13<>"" thì lấy dữ liệu của các cột mình có đánh số từ 1 đến 20, lưu ý là các cột này không liên tiếp nhau, cụ thể là sẽ lấy dữ liệu của cột B, C, F -> U, CN, DC
Anh chị xem trong file đính kèm giúp mình nhé.
Thank!
 

File đính kèm

Theo mình việc tách thành 2 fie là kg cần thiết. Chỉ cần 2 sheet "ANXONG" và "THA" cùng file là được.

Ngoài ra, trong Danh sách, nên để "Cột này tự tính" xuống cuôi.

Tôi sẽ lấy dữ liệu của các cột (của [vba.xls].tha!) B, C, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, CN, DC để chuyển sang sheet ANXONG.

Hãy đợi viết xong thì gửi file
 
Tôi đã dồn Sheet ANXONG của file danh sach sang vba.xls

Vô tình xóa sheet vba

Chú ý cột tự tính được chuyển về sau. Nhưng nếu bạn muốn thì sau chuyển dữ liệu bạn thêm cột mơi vô
 

File đính kèm

kulyvn đã viết:
Mình cần viết 1 đoạn code để tổng hợp trong file Danh sach.xls với điều kiện như sau:
Nếu [vba.xls]THA!$CN$10:$CN$13<>"" thì lấy dữ liệu của các cột mình có đánh số từ 1 đến 20, lưu ý là các cột này không liên tiếp nhau, cụ thể là sẽ lấy dữ liệu của cột B, C, F -> U, CN, DC
Anh chị xem trong file đính kèm giúp mình nhé.
Thank!
Nhấp chuột vào đây để mở rộng...
Thứ nhất: bắt buộc cn10,11,12,13 cùng <>"" hay như thế nào
Thứ 2: chỉ lấy dl từ dòng 10 đến 13?
Trong file danh sach, có 1 cột tự tính, vậy ct nó có phức tạp k? Nếu k thì tại sao k code luôn?
 
Tại vì file gốc VBA.xls dung lượng rất lớn và file danhsach.xls còn để gửi đi nữa nên mình phải tách ra để gửi đi.
Vì file thiết kế theo mẫu đã quy định sẵn nên k thể đưa "Cột này tự tính" xuống cuối được. Vì "Cột này tự tính" = sum(ô11:ô18) nên nếu tính có thể tính được thì bạn đưa công thức vào luôn ô này được không?
haonlh đã viết:
Theo mình việc tách thành 2 fie là kg cần thiết. Chỉ cần 2 sheet "ANXONG" và "THA" cùng file là được.

Ngoài ra, trong Danh sách, nên để "Cột này tự tính" xuống cuôi.

Tôi sẽ lấy dữ liệu của các cột (của [vba.xls].tha!) B, C, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, CN, DC để chuyển sang sheet ANXONG.

Hãy đợi viết xong thì gửi file
Nhấp chuột vào đây để mở rộng...
 
Khi đủ điều kiện CN10:CN60000<>"" thì mới xuât dữ liệu qua file danhsach.xls
Cột tự tính = sum (ô11:ô18), nếu có thể tính được trong công thức thì code luôn ô đó càng tốt ạ. Vì mình sợ code thêm ô đó phức tạp nên để tự tính để đặt sum(ô11:ô18) cho nó gọn.
quanluu1989 đã viết:
Thứ nhất: bắt buộc cn10,11,12,13 cùng <>"" hay như thế nào
Thứ 2: chỉ lấy dl từ dòng 10 đến 13?
Trong file danh sach, có 1 cột tự tính, vậy ct nó có phức tạp k? Nếu k thì tại sao k code luôn?
Nhấp chuột vào đây để mở rộng...
 
kulyvn đã viết:
Khi đủ điều kiện CN10:CN60000<>"" thì mới xuât dữ liệu qua file danhsach.xls
Cột tự tính = sum (ô11:ô18), nếu có thể tính được trong công thức thì code luôn ô đó càng tốt ạ. Vì mình sợ code thêm ô đó phức tạp nên để tự tính để đặt sum(ô11:ô18) cho nó gọn.
Nhấp chuột vào đây để mở rộng...

Vẫn chưa hiểu ở cột CN, ý bạn chỉ lấy những dòng mà CN <>"" hay bắt buộc các cell cột CN phải cùng <>"", nếu có 1 cell trống thì k lấy dữ liệu nữa?
 
Chỉ lấy những dòng mà CN <>"" chứ không phải tất cả các ô ở cột CN đều <>"" mới lấy nha bạn.
quanluu1989 đã viết:
Vẫn chưa hiểu ở cột CN, ý bạn chỉ lấy những dòng mà CN <>"" hay bắt buộc các cell cột CN phải cùng <>"", nếu có 1 cell trống thì k lấy dữ liệu nữa?
Nhấp chuột vào đây để mở rộng...
 
Mình up lại 2 file gốc, cách lấy dữ liệu cũng tương tự như vậy , mình đã lược bỏ bớt 1 số ô không cần thiết, cám ơn bạn nhiều nhé@$@!^%@$@!^%
Lấy dữ liệu từ fiel Tonghop sang file Danhsach, những ô nào ở cột CN file TongHop <>"" thì sẽ lấy dữ liệu các ô tương ứng ở dòng đó qua file Danhsach
quanluu1989 đã viết:
Ok, chiều sẽ có code cho bạn.
Nhấp chuột vào đây để mở rộng...
 

File đính kèm

Lần chỉnh sửa cuối:
kulyvn đã viết:
Mình up lại 2 file gốc, cách lấy dữ liệu cũng tương tự như vậy , mình đã lược bỏ bớt 1 số ô không cần thiết, cám ơn bạn nhiều nhé@$@!^%@$@!^%
Lấy dữ liệu từ fiel Tonghop sang file Danhsach, những ô nào ở cột CN file TongHop <>"" thì sẽ lấy dữ liệu các ô tương ứng ở dòng đó qua file Danhsach
Nhấp chuột vào đây để mở rộng...

Mình giúp bạn đổ dữ liệu về file thui, còn vấn đề sort, thì bạn nghiên cứu Custom Sort và ghi macro cho nó là ok.

Mã: 
Sub FilterData()
    Application.ScreenUpdating = False
    Range("A5:M" & Range("A65000").End(3).Row + 1).Clear
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
    Range("B5").CopyFromRecordset cn.Execute("SELECT f92,'',f8,f9,f6 & '/'& f3 & f5,f7,f10,f11,f12,f13,f107 FROM [A10:DC60000] where f92 is not null")
    Range("A5:A" & Range("B65000").End(3).Row).Value = "=row()-4"
    Range("A5:M" & Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
End Sub
 
cám ơn bạn nhiều nhé, mình tạo thêm 1 nút để sort nữa là ok
quanluu1989 đã viết:
Mình giúp bạn đổ dữ liệu về file thui, còn vấn đề sort, thì bạn nghiên cứu Custom Sort và ghi macro cho nó là ok.

Mã: 
Sub FilterData()
    Application.ScreenUpdating = False
    Range("A5:M" & Range("A65000").End(3).Row + 1).Clear
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
    Range("B5").CopyFromRecordset cn.Execute("SELECT f92,'',f8,f9,f6 & '/'& f3 & f5,f7,f10,f11,f12,f13,f107 FROM [A10:DC60000] where f92 is not null")
    Range("A5:A" & Range("B65000").End(3).Row).Value = "=row()-4"
    Range("A5:M" & Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
End Sub
Nhấp chuột vào đây để mở rộng...
 
"SELECT f92,'',f8,f9,f6
f trong câu lệnh này có nghia là gì vậy a?
quanluu1989 đã viết:
Mình giúp bạn đổ dữ liệu về file thui, còn vấn đề sort, thì bạn nghiên cứu Custom Sort và ghi macro cho nó là ok.

Mã: 
Sub FilterData()
    Application.ScreenUpdating = False
    Range("A5:M" & Range("A65000").End(3).Row + 1).Clear
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
    Range("B5").CopyFromRecordset cn.Execute("SELECT f92,'',f8,f9,f6 & '/'& f3 & f5,f7,f10,f11,f12,f13,f107 FROM [A10:DC60000] where f92 is not null")
    Range("A5:A" & Range("B65000").End(3).Row).Value = "=row()-4"
    Range("A5:M" & Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
End Sub
Nhấp chuột vào đây để mở rộng...
 
kulyvn đã viết:
"SELECT f92,'',f8,f9,f6
f trong câu lệnh này có nghia là gì vậy a?
Nhấp chuột vào đây để mở rộng...
fxx có thể gọi là tiêu đề các cột của bảng dữ liệu trong ADO khi bảng của bạn để option là không lấy tiêu đề cột mà chỉ lấy dữ liệu bên trong.
Bạn muốn rõ hơn thì tìm hiểu về ADO
Nếu ko dùng ADO thì có lẽ dùng mảng sẽ dể hiểu hơn với bạn. hj
 
Khi cập nhật dữ liệu qua file Danhsach thì các định dạng của các ô mình đã cài đặt từ trước lại mất hết, Có thể copy qua chỉ lấy dữ liệu thôi còn định dạng thì theo định dạng ở file danhsach đã cài đặt sẵn được không a?
Khi mình copy file danhsach vào thư mục của file gốc tonghop nhưng nó báo lỗi màu vàng vùng này là sao nhỉ,
Range("B5").CopyFromRecordset cn.Execute("SELECT f92,'',f8,f9,f6 & '/'& f3 & f5,f7,f10,f11,f12,f13,f107 FROM [A10:DC60000] where f92 is not null")
quanluu1989 đã viết:
fxx có thể gọi là tiêu đề các cột của bảng dữ liệu trong ADO khi bảng của bạn để option là không lấy tiêu đề cột mà chỉ lấy dữ liệu bên trong.
Bạn muốn rõ hơn thì tìm hiểu về ADO
Nếu ko dùng ADO thì có lẽ dùng mảng sẽ dể hiểu hơn với bạn. hj
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
kulyvn đã viết:
Khi cập nhật dữ liệu qua file Danhsach thì các định dạng của các ô mình đã cài đặt từ trước lại mất hết, Có thể copy qua chỉ lấy dữ liệu thôi còn định dạng thì theo định dạng ở file danhsach đã cài đặt sẵn được không a?
Khi mình copy file danhsach vào thư mục của file gốc tonghop nhưng nó báo lỗi màu vàng vùng này là sao nhỉ,
Range("B5").CopyFromRecordset cn.Execute("SELECT f92,'',f8,f9,f6 & '/'& f3 & f5,f7,f10,f11,f12,f13,f107 FROM [A10:DC60000] where f92 is not null")
Nhấp chuột vào đây để mở rộng...
Thứ 1, mình thấy có mất định dạng đâu nhỉ, nếu mất thì bạn có thể ghi macro để định dạng lại đc đúng k?
Thứ 2: Lỗi nó báo như thế nào?
 
1. thì ra là file gốc của mình có rất nhiều sheet, khi mình để nguyên các sheet đó thì nó báo lỗi, còn file mình gửi lên mình đã xóa bớt các sheet khác cho nhẹ thì cập nhật được, có thể để nguyên các sheet khác mà vẫn cập nhật được không vây bạn?
2. dữ liệu cập nhật qua bị mất định dạng ở file danh sách, giờ làm thêm macro nữa thì bất tiện quá, có thể nào tích hợp trong cùng 1 macro Kèm theo luôn sort theo cột B (bắt đầy từ tháng 10, tháng 11... thág 9) , cột E, cột D luôn không vậy bạn,
Cám ơn bạn nheièu nhé@$@!^%@$@!^%
quanluu1989 đã viết:
ko biết file bạn làm có khác với file bạn gửi ko? tôt nhất bạn nên gửi file bạn đang thực hiện lên, mới bắt chính xác đc bệnh.
Nhấp chuột vào đây để mở rộng...
 
Mình thấy nó báo lỗi vùng này
Range("B5").CopyFromRecordset cn.Execute("SELECT f92,'',f8,f9,f6 & '/'& f3 & f5,f7,f10,f11,f12,f13,f107 FROM [A10:DC60000] where f92 is not null")
Nên mình nghĩ bạn thêm địa chỉ sheet THA của file TongHop vào nữa là chắc ok, có lẽ vì nhiều sheet nên nó không chọn được sheet nào nên báo lỗi thôi
quanluu1989 đã viết:
ko biết file bạn làm có khác với file bạn gửi ko? tôt nhất bạn nên gửi file bạn đang thực hiện lên, mới bắt chính xác đc bệnh.
Nhấp chuột vào đây để mở rộng...
 
kulyvn đã viết:
1. thì ra là file gốc của mình có rất nhiều sheet, khi mình để nguyên các sheet đó thì nó báo lỗi, còn file mình gửi lên mình đã xóa bớt các sheet khác cho nhẹ thì cập nhật được, có thể để nguyên các sheet khác mà vẫn cập nhật được không vây bạn?
2. dữ liệu cập nhật qua bị mất định dạng ở file danh sách, giờ làm thêm macro nữa thì bất tiện quá, có thể nào tích hợp trong cùng 1 macro Kèm theo luôn sort theo cột B (bắt đầy từ tháng 10, tháng 11... thág 9) , cột E, cột D luôn không vậy bạn,
Cám ơn bạn nheièu nhé@$@!^%@$@!^%
Nhấp chuột vào đây để mở rộng...

Fix lỗi sheet và tự sort theo đk, còn định dạng cell của bạn như thế nào thì mình ko rõ, bạn tự làm và add thêm vào code.
 

File đính kèm

Giả sử mình muốn thay đổi điều kiện để lọc: nếu có bất kỳ ô nào từ CR10:CR60000 = 1 thì sẽ lấy dữ liệu theo các cột giống như đã lấy ở file danhsach vậy ?
Thay đổi code chỗ đoạn này fai ko
where f92 is not null
kulyvn đã viết:
ok bạn, như vậy cũng tuyệt vời lắm rồi,thanks nhiều nhé @$@!^%@$@!^%
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
kulyvn đã viết:
Giả sử mình muốn thay đổi điều kiện để lọc: nếu có bất kỳ ô nào từ CR10:CR60000 = 1 thì sẽ lấy dữ liệu theo các cột giống như đã lấy ở file danhsach vậy ?
Thay đổi code chỗ đoạn này fai ko
where f92 is not null
Nhấp chuột vào đây để mở rộng...
Đúng rùi bạn, f96 =1 (column(CR:CR) =96)
 
kulyvn đã viết:
mình sửa như thế nhưng sao không được vậy?
Range("B5").CopyFromRecordset cn.Execute("SELECT f92,'',f8,f9,f6 & '/'& f3 & f5,f7,f10,f11,f12,f13,f107 FROM [THA$A10:DC60000] where f96 =1 (column(THA$CR10:CR60000) =96)")
Nhấp chuột vào đây để mở rộng...
Trời, bỏ cái này đi (column(THA$CR10:CR60000) =96)
Cái này mình chỉ giải thích vi sao nó là f96 thui mà vì CR là cột 96
 
OK,
sao mình gộp 2 macro của 2 sheet khác vào chung 1 macro cho tiện mà không được nhỉ, vì file của mình có tới hơn 10 sheet cũng tổng hợp theo kiểu tương tự như vậy nên mình muốn gộp chung các macro của mỗi sheet vào chung 1 macro, khi chạy sẽ tự tổng hợp cho các sheet khác luôn có được không vậy bạn?
Code:
Sub TONGHOP()
Application.ScreenUpdating = False
Range("A5:M" & Range("A65000").End(3).Row + 1).ClearContents
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
Range("B5").CopyFromRecordset cn.Execute("SELECT f92,'',f8,f9,f6 & '/'& f3 & f5,f7,f10,f11,f12,f13,f107 FROM [THA$A10:DC60000] where f92 is not null")
Range("A5:A" & Range("B65000").End(3).Row).Value = "=row()-4"
Range("A5:M" & Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
ActiveWorkbook.Worksheets("DANH SACH").Sort.SortFields.Add Key:=Range("B5:B" & Range("B65000").End(3).Row _
), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"Tháng 10,Tháng 11,Tháng 12,Tháng 1,Tháng 2,Tháng 3,Tháng 4,Tháng 5,Tháng 6,Tháng 7,Tháng 8,Tháng 9" _
, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DANH SACH").Sort
.SetRange Range("A5:M" & Range("B65000").End(3).Row)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub UT()
Application.ScreenUpdating = False
Range("A5:M" & Range("A65000").End(3).Row + 1).ClearContents
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
Range("B5").CopyFromRecordset cn.Execute("SELECT f92,'',f8,f9,f6 & '/'& f3 & f5,f7,f10,f11,f12,f13,f107 FROM [THA$A10:DC60000] where f96 =1")
Range("A5:A" & Range("B65000").End(3).Row).Value = "=row()-4"
Range("A5:M" & Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
ActiveWorkbook.Worksheets("UT").Sort.SortFields.Add Key:=Range("B5:B" & Range("B65000").End(3).Row _
), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"Tháng 10,Tháng 11,Tháng 12,Tháng 1,Tháng 2,Tháng 3,Tháng 4,Tháng 5,Tháng 6,Tháng 7,Tháng 8,Tháng 9" _
, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("UT").Sort
.SetRange Range("A5:M" & Range("B65000").End(3).Row)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub


quanluu1989 đã viết:
Trời, bỏ cái này đi (column(THA$CR10:CR60000) =96)
Cái này mình chỉ giải thích vi sao nó là f96 thui mà vì CR là cột 96
Nhấp chuột vào đây để mở rộng...
 
kulyvn đã viết:
OK,
sao mình gộp 2 macro của 2 sheet khác vào chung 1 macro cho tiện mà không được nhỉ,
Nhấp chuột vào đây để mở rộng...
Thế thì bạn đưa tham số vào sub trung gian và gọi nó thui
Như thế này
Mã: 
Sub TONGHOP()
  Call TONGHOPDL("DANH SACH", "f92 is not null")
  Call TONGHOPDL("UT", "f96 =1")
End Sub


Sub TONGHOPDL(sheetname As String, dk As String)
Application.ScreenUpdating = False
With Sheets(sheetname)
    .Range("A5:M" & .Range("A65000").End(3).Row + 1).ClearContents
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
    .Range("B5").CopyFromRecordset cn.Execute("SELECT f92,'',f8,f9,f6 & '/'& f3 & f5,f7,f10,f11,f12,f13,f107 FROM [THA$A10:DC60000] where " & dk)
    .Range("A5:A" & .Range("B65000").End(3).Row).Value = "=row()-4"
    .Range("A5:M" & .Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
    .Sort.SortFields.Add Key:=.Range("B5:B" & .Range("B65000").End(3).Row _
    ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
    "Tháng 10,Tháng 11,Tháng 12,Tháng 1,Tháng 2,Tháng 3,Tháng 4,Tháng 5,Tháng 6,Tháng 7,Tháng 8,Tháng 9" _
    , DataOption:=xlSortNormal
End With
With Sheets(sheetname).Sort
    .SetRange Sheets(sheetname).Range("A5:M" & Sheets(sheetname).Range("B65000").End(3).Row)
    .Header = xlNo
    .Apply
End With
End Sub
 
Lần chỉnh sửa cuối:
Mình muốn ghép 2 macro vào chung cho tiện nhưng sao không được vậy? 1 marco sắp xếp cả danh sách theo cột B bắt đầu từ tháng 10... tháng 9 và sau đó 1 marco sắp xếp theo tên ở cột L nhưng cả danh sách vẫn giữ bắt đầu từ tháng 10 đến tháng 9.
Code
Sub TONGHOP()
Application.ScreenUpdating = False
Range("A5:M" & Range("A65000").End(3).Row + 1).ClearContents
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
Range("B5").CopyFromRecordset cn.Execute("SELECT f92,'',f8,f9,f6 & '/'& f3 & f5,f7,f10,f11,f12,f13,f107 FROM [THA$A10:DC60000] where f92 is not null")
Range("A5:A" & Range("B65000").End(3).Row).Value = "=row()-4"
Range("A5:M" & Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
ActiveWorkbook.Worksheets("DANH SACH").Sort.SortFields.Add Key:=Range("B5:B" & Range("B65000").End(3).Row _
), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
"Tháng 10,Tháng 11,Tháng 12,Tháng 1,Tháng 2,Tháng 3,Tháng 4,Tháng 5,Tháng 6,Tháng 7,Tháng 8,Tháng 9" _
, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DANH SACH").Sort
.SetRange Range("A5:M" & Range("B65000").End(3).Row)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B5").Select
ActiveWorkbook.Worksheets("DANH SACH").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("DANH SACH").Sort.SortFields.Add Key:=Range( _
"L5:L65000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("DANH SACH").Sort
.SetRange Range("B5:M65000")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub


quanluu1989 đã viết:
Fix lỗi sheet và tự sort theo đk, còn định dạng cell của bạn như thế nào thì mình ko rõ, bạn tự làm và add thêm vào code.
Nhấp chuột vào đây để mở rộng...
 
kulyvn đã viết:
Mình muốn ghép 2 macro vào chung cho tiện nhưng sao không được vậy? 1 marco sắp xếp cả danh sách theo cột B bắt đầu từ tháng 10... tháng 9 và sau đó 1 marco sắp xếp theo tên ở cột L nhưng cả danh sách vẫn giữ bắt đầu từ tháng 10 đến tháng 9.
Nhấp chuột vào đây để mở rộng...
Bạn thử thế này. Ghép 2 cái vào làm 1 (custom sort)
Mã: 
...
    ActiveWorkbook.Worksheets("DANH SACH").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DANH SACH").Sort.SortFields.Add Key:=Range("B5:B" & Range("B65000").End(3).Row _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Tháng 10,Tháng 11,Tháng 12,Tháng 1,Tháng 2,Tháng 3,Tháng 4,Tháng 5,Tháng 6,Tháng 7,Tháng 8,Tháng 9" _
        , DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("DANH SACH").Sort.SortFields.Add Key:=Range("L5:L" & Range("B65000").End(3).Row _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DANH SACH").Sort
        .SetRange Range("A5:M" & Range("B65000").End(3).Row)
        .Header = xlNo
        .Apply
    End With
...
 
@$@!^%@$@!^%@$@!^%@$@!^%
quanluu1989 đã viết:
Bạn thử thế này. Ghép 2 cái vào làm 1 (custom sort)
Mã: 
...
    ActiveWorkbook.Worksheets("DANH SACH").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DANH SACH").Sort.SortFields.Add Key:=Range("B5:B" & Range("B65000").End(3).Row _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
        "Tháng 10,Tháng 11,Tháng 12,Tháng 1,Tháng 2,Tháng 3,Tháng 4,Tháng 5,Tháng 6,Tháng 7,Tháng 8,Tháng 9" _
        , DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("DANH SACH").Sort.SortFields.Add Key:=Range("L5:L" & Range("B65000").End(3).Row _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DANH SACH").Sort
        .SetRange Range("A5:M" & Range("B65000").End(3).Row)
        .Header = xlNo
        .Apply
    End With
...
Nhấp chuột vào đây để mở rộng...
 
mình đã thử gộp các macro vào chung nhưng có 1 số lỗi anh có thể kiểm tra lại giúp em với . chi tiết cụ thể em có ghi rõ trong file đính kèm , cám ơn anh -=.,,-=.,,
quanluu1989 đã viết:
Thế thì bạn đưa tham số vào sub trung gian và gọi nó thui
Như thế này
Mã: 
Sub TONGHOP()
  Call TONGHOPDL("DANH SACH", "f92 is not null")
  Call TONGHOPDL("UT", "f96 =1")
End Sub


Sub TONGHOPDL(sheetname As String, dk As String)
Application.ScreenUpdating = False
With Sheets(sheetname)
    .Range("A5:M" & .Range("A65000").End(3).Row + 1).ClearContents
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\TongHop.xls;Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
    .Range("B5").CopyFromRecordset cn.Execute("SELECT f92,'',f8,f9,f6 & '/'& f3 & f5,f7,f10,f11,f12,f13,f107 FROM [THA$A10:DC60000] where " & dk)
    .Range("A5:A" & .Range("B65000").End(3).Row).Value = "=row()-4"
    .Range("A5:M" & .Range("B65000").End(3).Row).Borders.LineStyle = xlContinuous
    .Sort.SortFields.Add Key:=.Range("B5:B" & .Range("B65000").End(3).Row _
    ), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:= _
    "Tháng 10,Tháng 11,Tháng 12,Tháng 1,Tháng 2,Tháng 3,Tháng 4,Tháng 5,Tháng 6,Tháng 7,Tháng 8,Tháng 9" _
    , DataOption:=xlSortNormal
End With
With Sheets(sheetname).Sort
    .SetRange Sheets(sheetname).Range("A5:M" & Sheets(sheetname).Range("B65000").End(3).Row)
    .Header = xlNo
    .Apply
End With
End Sub
Nhấp chuột vào đây để mở rộng...
 

File đính kèm

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

H
Cách tính ngày kết thúc khóa học (1 người xem)
Trả lời
2
Đọc
31
Gà Con yêu VBA
Gà Con yêu VBA
E
  • Question Question
Cách nào để sắp xếp lái xe vào list danh sách (2 người xem)
Trả lời
3
Đọc
166
Gà Con yêu VBA
Gà Con yêu VBA
havanvinhqh
  • Đã giải quyết
Nâng cấp PM Excel để chạy mượt mà hơn
    • Ngạc nhiên
    • Cười
Trả lời
5
Đọc
287
Trần Văn Bình
T
L
  • Question Question
Viết code tìm kiếm các file trong Folder
Trả lời
68
Đọc
13K
HeSanbi
HeSanbi
ongke0711
Tạo thông báo nhắc nhở công việc (Excel + PowerShell + Task scheduler)
    • Thích
    • Yêu thích
Trả lời
16
Đọc
456
ongke0711
ongke0711
SA_DQ
[2] Bình luận của Copilot về các ván cờ vua
Trả lời
17
Đọc
445
SA_DQ
SA_DQ
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
5 6 7
Trả lời
661
Đọc
103K
pycckuu410
pycckuu410
Trungvt3
Get data từ From file excel workbook, load to xong dữ liệu thì Định dạng bị thay đổi so với dữ liệu từ file excel
Trả lời
1
Đọc
77
ptm0412
ptm0412
phuongnam366377
Xây dựng RPC Server cho Excel / Access bằng Delphi – Tận dụng lại DLL và bảo mật mã nguồn
    • Thích
Trả lời
19
Đọc
1K
phuongnam366377
phuongnam366377
Nguyễn Duy Tuân
Hàm BS_TEXT trộn văn bản trong Excel với Add-in A-Tools v10
Trả lời
1
Đọc
491
Nguyễn Duy Tuân
Nguyễn Duy Tuân
G
  • Question Question
Xin hỏi về Lỗi Path Not Found
Trả lời
11
Đọc
233
ongke0711
ongke0711
Maika8008
Liệt kê file trong 1 thư mục của Google Drive
Trả lời
0
Đọc
91
Maika8008
Maika8008
K
Tư vấn dùng máy tính chip AMD hay Intel
Trả lời
6
Đọc
335
vuvo_nhenhang
V
Maika8008
Dùng Apps Script gửi mail hàng loạt từ Google sheets
    • Thích
    • Yêu thích
Trả lời
6
Đọc
296
befaint
befaint
Tiger Nau
In dữ liệu trong word bị lỗi
Trả lời
0
Đọc
69
Tiger Nau
Tiger Nau
J
lỗi không lưu được dữ liệu trong file excel
Trả lời
3
Đọc
127
jenny 129
J
N
  • Question Question
Một lỗi rất khó chịu của VBA khi đọc chuỗi Unicode
    • Thích
Trả lời
3
Đọc
200
ongke0711
ongke0711
nvtnet
  • Question Question
Nhờ các bác giúp đỡ tạo chương trình sao chép dữ liệu vào thư mục con
Trả lời
0
Đọc
96
nvtnet
nvtnet
GPE-Trợ Lý
[ZOOM] POWER QUERY TRAINING (LỚP HỌC POWER QUERY THÁNG 04/2026) (1 người xem)
    • Thích
Trả lời
0
Đọc
4K
GPE-Trợ Lý
GPE-Trợ Lý
minhminh27
File excel thực hiện thao tác lưu trữ (Archive) email của outlook 365
Trả lời
0
Đọc
92
minhminh27
minhminh27
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