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

VINCE1501 · 27/11/21

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 ạ

snow25 · 29/11/21

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 ạ

Có chức năng record macro đấy bạn.

VINCE1501 · 29/11/21

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

Nhattanktnn · 29/11/21

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

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ả

SA_DQ · 29/11/21

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

VINCE1501 · 29/11/21

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: 29/11/21

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ả

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 ạ

SA_DQ · 29/11/21

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. . . . .

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,. . . )

VINCE1501 · 29/11/21

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

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: 29/11/21

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,. . . )

Hihi, mình gà VBA nên nhờ bạn nói rõ hơn giúp mình không ạ.

SA_DQ · 29/11/21

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.

Phuocam · 29/11/21

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 ạ.

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.

.

VINCE1501 · 29/11/21

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.

.

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) ạ

Phuocam · 29/11/21

VINCE1501 đã viết:
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) ạ

Có.

Tỉnh và huyện tương úng với cột nào trong sheet Data ?

.

VINCE1501 · 29/11/21

Tỉnh là cột E, Bộ phận là cột F ạ

Phuocam · 29/11/21

VINCE1501 đã viết:
Tỉnh là cột E, Bộ phận là cột F ạ

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

VINCE1501 · 30/11/21

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

Bạn ơi nó báo lỗi như này ạ

Phuocam · 30/11/21

VINCE1501 đã viết:
Bạn ơi nó báo lỗi như này ạ

Đã cập nhật, tải lại code trong bài #14.

.

VINCE1501 · 30/11/21

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 ạ

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

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

Thành viên gắn bó

/(hông là gì!

File đính kèm

Thành viên mới

/(hông là gì!

Thành viên mới

/(hông là gì!

File đính kèm

Thành viên mới

File đính kèm

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới