Dùng code tách File báo cáo sử dụng Data Validation

Liên hệ QC
V

VINCE1501

Thành viên mới
Tham gia
26/6/17
Bài viết
8
Được thích
0
Giới tính
Nữ
Nghề nghiệp
Nhân viên
Nhờ các anh chị giúp em, em có một Sheet Report là form báo cáo chung. Bình thường em sẽ lọc Tỉnh ở B6, tiếp đó B7 sẽ hiển thị các Quận huyện thuộc tỉnh được chọn=>Báo cáo tự động nhảy số do đã được dùng công thức. Sau đó e sẽ Move anh copy để tách báo cáo của từng Quận huyện ra và lưu file là tên của Quận huyện đó (theo tên ở ô B7). Nhờ Anh/chị có code nào tự động thay thế làm thủ công như trên mà vẫn giữ được form như Sheet Report ko ạ. Ví dụ em lấy ít, tuy nhiên thực tế có rất nhiều nên làm thủ công mất thời gian ạ
Lần đầu em đăng mong ANh/chị giúp đỡ em ạ
 

File đính kèm

  • Report Thuy.xlsx
    374.8 KB · Đọc: 13
Sắp xếp theo thời gian sắp xếp theo bầu chọn
VINCE1501 đã viết:
Nhờ các anh chị giúp em, em có một Sheet Report là form báo cáo chung. Bình thường em sẽ lọc Tỉnh ở B6, tiếp đó B7 sẽ hiển thị các Quận huyện thuộc tỉnh được chọn=>Báo cáo tự động nhảy số do đã được dùng công thức. Sau đó e sẽ Move anh copy để tách báo cáo của từng Quận huyện ra và lưu file là tên của Quận huyện đó (theo tên ở ô B7). Nhờ Anh/chị có code nào tự động thay thế làm thủ công như trên mà vẫn giữ được form như Sheet Report ko ạ. Ví dụ em lấy ít, tuy nhiên thực tế có rất nhiều nên làm thủ công mất thời gian ạ
Lần đầu em đăng mong ANh/chị giúp đỡ em ạ
Nhấp chuột vào đây để mở rộng...
Có chức năng record macro đấy bạn.
1638166673022.png
 
Upvote 0
Record này mình sẽ phải làm bao nhiêu thao tác để file sẽ tự động chạy bạn?, mình có làm thử mà thấy nó chưa hiểu ý là lưu file là tên bộ phận được lọc. Nhờ bạn chỉ rõ giúp mình được không? Cảm ơn bạn
 
Upvote 0
VINCE1501 đã viết:
Record này mình sẽ phải làm bao nhiêu thao tác để file sẽ tự động chạy bạn?, mình có làm thử mà thấy nó chưa hiểu ý là lưu file là tên bộ phận được lọc. Nhờ bạn chỉ rõ giúp mình được không? Cảm ơn bạn
Nhấp chuột vào đây để mở rộng...
Bạn lưu mỗi sheet report mà report lại liên quan tới Data, vậy khi lưu vẫn chấp nhận cho nó link tới file gốc này hả
 
Upvote 0
Mình xài hàm DSUM() với trợ giúp từ VBA
& chỉ mới dẫn ra kết quả ở 5 dòng thôi
Bạn thử kiểm tra & nếu ưng ý thì ta lại tiếp tục

PHP: 
Sub TongHopSoLieu()
 Dim WF As Object, Sh As Worksheet, CSDL As Range
 Dim Rws As Long, J As Long
 
 Set WF = Application.WorksheetFunction
 Sheet4.Select
 Set Sh = ThisWorkbook.Worksheets("Data")
 Rws = Sh.[b5].CurrentRegion.Rows.Count
 Set CSDL = Sh.[B4].Resize(Rws, 16)
 Sh.Range("GPE")(8).Value = [b5].Value  'Tháng  '
 Sh.Range("GPE")(9).Value = [B4].Value  'Nam  '
 Sh.Range("GPE")(6).Value = [b6].Value  'Thành Fó  '
 Sh.Range("GPE")(7).Value = [B7].Value  '2uân  '
 For J = 16 To 20
    Sh.Range("GPE")(10).Value = Cells(J, "B").Value
    Cells(J, "F").Value = WF.DSum(CSDL, Sh.[P4], Sh.Range("GPE"))

 Next J
 MsgBox "Xong Rôi!", , "GPE.COM Xin Chào!"
 End Sub
 

File đính kèm

  • CSDL.rar
    413 KB · Đọc: 6
Upvote 0
Mình ko muốn link nữa mà để copy chết luôn (công thức đã tự chạy khi mình chọn bộ phận) và vẫn giữ nguyên form. Mục đich là để gửi đi cho các bộ phận nên không để link nữa ạ
Bài đã được tự động gộp:

Nhattanktnn đã viết:
Bạn lưu mỗi sheet report mà report lại liên quan tới Data, vậy khi lưu vẫn chấp nhận cho nó link tới file gốc này hả
Nhấp chuột vào đây để mở rộng...
Mình ko muốn link nữa mà để copy chết luôn (công thức đã tự chạy khi mình chọn bộ phận) và vẫn giữ nguyên form. Mục đich là để gửi đi cho các bộ phận nên không để link nữa ạ
 
Upvote 0
VINCE1501 đã viết:
Mình ko muốn link nữa mà để copy chết luôn (công thức đã tự chạy khi mình chọn bộ phận) và vẫn giữ nguyên form. . . . .
Nhấp chuột vào đây để mở rộng...
Thì chuyển sang xài macro sự kiện tại ô chọn bộ phận, thay vì chọn xong 'năm', 'tháng', tỉnh/thành & quận/huện xong cho macro chạy (bỡi, ví dụ như tổ hợp phím tắt,. . . )
 
Upvote 0
SA_DQ đã viết:
Mình xài hàm DSUM() với trợ giúp từ VBA
& chỉ mới dẫn ra kết quả ở 5 dòng thôi
Bạn thử kiểm tra & nếu ưng ý thì ta lại tiếp tục

PHP: 
Sub TongHopSoLieu()
 Dim WF As Object, Sh As Worksheet, CSDL As Range
 Dim Rws As Long, J As Long
 
 Set WF = Application.WorksheetFunction
 Sheet4.Select
 Set Sh = ThisWorkbook.Worksheets("Data")
 Rws = Sh.[b5].CurrentRegion.Rows.Count
 Set CSDL = Sh.[B4].Resize(Rws, 16)
 Sh.Range("GPE")(8).Value = [b5].Value  'Tháng  '
 Sh.Range("GPE")(9).Value = [B4].Value  'Nam  '
 Sh.Range("GPE")(6).Value = [b6].Value  'Thành Fó  '
 Sh.Range("GPE")(7).Value = [B7].Value  '2uân  '
 For J = 16 To 20
    Sh.Range("GPE")(10).Value = Cells(J, "B").Value
    Cells(J, "F").Value = WF.DSum(CSDL, Sh.[P4], Sh.Range("GPE"))

 Next J
 MsgBox "Xong Rôi!", , "GPE.COM Xin Chào!"
 End Sub
Nhấp chuột vào đây để mở rộng...
Dạ mình xin phép nói rõ hơn ý của mình ạ. Mình lọc ở B6 trước, B7 mình đã làm công thức để chỉ hiện ra các quận huyện thuộc B6, sau đó tách file tương ứng quận huyện được chọn và lưu file với tên là tên của ô B7. B5 và 4 không cần lọc ạ.
Bài đã được tự động gộp:

SA_DQ đã viết:
Thì chuyển sang xài macro sự kiện tại ô chọn bộ phận, thay vì chọn xong 'năm', 'tháng', tỉnh/thành & quận/huện xong cho macro chạy (bỡi, ví dụ như tổ hợp phím tắt,. . . )
Nhấp chuột vào đây để mở rộng...
Hihi, mình gà VBA nên nhờ bạn nói rõ hơn giúp mình không ạ.
 
Upvote 0
Bạn xem file, chúng ta chắc đã đi được nữa đoạn đường thì phải & bạn tiến hành kiểm tra xem sao, nha.
 

File đính kèm

  • CSDL.rar
    414.4 KB · Đọc: 5
Upvote 0
VINCE1501 đã viết:
Dạ mình xin phép nói rõ hơn ý của mình ạ. Mình lọc ở B6 trước, B7 mình đã làm công thức để chỉ hiện ra các quận huyện thuộc B6, sau đó tách file tương ứng quận huyện được chọn và lưu file với tên là tên của ô B7. B5 và 4 không cần lọc ạ.
Nhấp chuột vào đây để mở rộng...
Sau khi chọn huyện, bạn nhấn vào nút "Tách File" để tạo file mới

Lưu ý: nếu tên file đã tồn tại, code sẽ ghi đè lên file cũ mà không cảnh báo.

.
 

File đính kèm

  • Report Thuy.xlsm
    382.8 KB · Đọc: 11
Upvote 0
Phuocam đã viết:
Sau khi chọn huyện, bạn nhấn vào nút "Tách File" để tạo file mới

Lưu ý: nếu tên file đã tồn tại, code sẽ ghi đè lên file cũ mà không cảnh báo.

.
Nhấp chuột vào đây để mở rộng...
Có cách nào mình không cần chọn huyện mà nó sẽ tự động lọc không ạ, và nó sẽ lưu vào một đường dẫn cho sẵn (folder mình đã tạo sẵn để lưu) ạ
 
Upvote 0
Tỉnh là cột E, Bộ phận là cột F ạ
 
Upvote 0
VINCE1501 đã viết:
Tỉnh là cột E, Bộ phận là cột F ạ
Nhấp chuột vào đây để mở rộng...
Bạn thay code này vào thử xem sao.
PHP: 
Option Explicit
Sub TachFile()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim Huyen As String
Dim strPath As String
Dim arrData
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False


With Sheets("Data") 'Change here, Tên sheet nguôn
    lastRow = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A4:R" & lastRow).Sort Key1:=.Range("E4"), Order1:=xlAscending, Key2:=.Range("F4"), Order2:=xlAscending, Header:=xlYes
    arrData = .Range("E5:F" & lastRow).Value
End With

Set ws = Sheets("Report") 'Change here , Tên sheet mau
strPath = ThisWorkbook.Path & "\"
    For i = 1 To UBound(arrData, 1)
        If arrData(i, 2) <> Huyen Then
            Huyen = arrData(i, 2)
            ws.Range("B7").Value = Huyen
            ws.Range("B6").Value = arrData(i, 1)
            ws.Copy
            With ActiveWorkbook
                .Sheets(1).Name = Huyen
                .Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value
                .Close True, strPath & Huyen & ".xlsx" ' Thay doi duong dan tai day
            End With
        End If
    Next i

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Phuocam đã viết:
Bạn thay code này vào thử xem sao.
PHP: 
Option Explicit
Sub TachFile()
Dim ws As Worksheet
Dim lastRow As Long, i As Long
Dim Huyen As String
Dim strPath As String
Dim arrData
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False


With Sheets("Data") 'Change here, Tên sheet nguôn
    lastRow = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A4:R" & lastRow).Sort Key1:=.Range("E4"), Order1:=xlAscending, Key2:=.Range("F4"), Order2:=xlAscending, Header:=xlYes
    arrData = .Range("E5:F" & lastRow).Value
End With

Set ws = Sheets("Report") 'Change here , Tên sheet mau
strPath = ThisWorkbook.Path & "\"
    For i = 1 To UBound(arrData, 1)
        If arrData(i, 2) <> Huyen Then
            Huyen = arrData(i, 2)
            ws.Range("B7").Value = Huyen
            ws.Range("B6").Value = arrData(i, 1)
            ws.Copy
            With ActiveWorkbook
                .Sheets(1).Name = Huyen
                .Sheets(1).UsedRange.Value = .Sheets(1).UsedRange.Value
                .Close True, strPath & Huyen & ".xlsx" ' Thay doi duong dan tai day
            End With
        End If
    Next i

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn ơi nó báo lỗi như này ạ
1638237725284.png
 
Upvote 0
Mình chạy đã ra được rồi bạn ạ, nhưng hình như là không đủ, Hà Nội chỉ ra 2 Quận(huyện) là Sóc Sơn và Đông Anh thiếu Đống Đa và trường hợp lấy tổng của Hà Nội bạn ạ
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

vuongnlks
Lấy dữ liệu 1 cột cụ thể theo ngày từ nhiều file CSV ứng với mã tương ứng trong cột MA CO PHIEU
Trả lời
1
Đọc
43
BuiQuangThuan
B
Salem999999999
Lọc dữ liệu có điều kiện
2
Trả lời
24
Đọc
512
thanthanhan
T
V
Hỗ trợ hàm Sumproduct và Subtotal trong GG Sheets
Trả lời
3
Đọc
212
nguyenngocphuongsw
nguyenngocphuongsw
son0611excel
  • Question
VBA tra cứu hình theo điều kiện
Trả lời
10
Đọc
197
tle2003
T
K
Tính tổng có điều kiện
Trả lời
4
Đọc
153
kimson_nb
K
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom