Hỏi về xuất lại báo cáo đã có sẵn (1 người xem)

sondaubac · 9/10/17

Mình tạo được 1 File tự động xuất Báo Cáo theo điều kiện lọc bằng cách tạo ra các sheet mới và đặt tên theo điều kiện lọc.

Lần 1: Khi xuất báo cáo lần 1 sẽ tạo ra các sheet mới và đặt tên theo điều kiện

Nhưng giả sử mình muốn xuất lại Báo cáo vì dữ liệu thay đổi thì phải xuất lại Lần 2

Nhưng mà sheet mới đã có tên rồi nên khi xuất lại Báo Cáo nó không tạo được sheet mới vì trùng tên, nhờ mọi người chỉ mình hướng khắc phục bằng cách xóa sheet trùng tên và tạo lại

Ý tưởng của mình là:
Trước khi xuất báo cáo, tìm xem có sheet nào đã có tên theo điều kiện lọc chưa
Nếu có thì xóa hết đi rồi mới làm báo cáo

Mã:

Sub BaoCao()
    Dim DKLoc As Range          'Khai bao Vung du lieu chua DIEU KIEN de loc du lieu
    'Dim VungDL_Loc As Range     'Khai bao Vung de loc du lieu
   
    Dim lr As Long              'Bien dong cuoi cua Vung Du Lieu can Loc
    lr = Sheet1.Cells(Rows.Count, 1).End(3).Row
    Dim lrDK As Integer         'Bien dong cuoi cua Vung DK loc (cot H la cot 8)
    lrDK = Sheet1.Cells(Rows.Count, 8).End(3).Row
   
    ' Gan vung chua DK loc tu cot H2 den cot H chua dong cuoi
    Set DKLoc = Sheet1.Range("H2:H" & lrDK)
    'Set VungDL_Loc = Sheet1.Range("A1:B" & lr)
   
    For Each DKLoc In DKLoc
       
        With Sheet1
       
            'Tat AutoFile trong sheet1 truoc da
            .AutoFilterMode = False
           
            ' Loc vung Du Lieu can tinh toan
            .Range("A1:B" & lr).AutoFilter
           
            ' Loc du lieu tai cot 1, dieu kien la gia tri cua vung chua DKLoc
            .Range("A1:B" & lr).AutoFilter Field:=1, Criteria1:=DKLoc.Value
           
            'Copy du lieu sau khi loc
            .Range("A1:B" & lr).Parent.AutoFilter.Range.Copy
           
            End With
           
                'Tao 1 sheet moi sau sheet cuoi
                Sheets.Add after:=Sheets(Sheets.Count)
               
                'Dat ten cho sheet moi tao
                Sheets(Sheets.Count).Name = DKLoc.Value
               
                'Paste du lieu BAO CAO sang sheet moi tao
                Sheets(Sheets.Count).Range("a1").PasteSpecial xlPasteValues
       
    Next DKLoc
     
    ' Khong loc du lieu nua
    Sheet1.AutoFilterMode = False
   
    ' Quay ve sheet DATA
    Sheet1.Select
    MsgBox "Da xuat xong tat ca cac bao cao"
   
End Sub

PacificPR · 9/10/17

sondaubac đã viết:
Mình tạo được 1 File tự động xuất Báo Cáo theo điều kiện lọc bằng cách tạo ra các sheet mới và đặt tên theo điều kiện lọc.

Lần 1: Khi xuất báo cáo lần 1 sẽ tạo ra các sheet mới và đặt tên theo điều kiện

Nhưng giả sử mình muốn xuất lại Báo cáo vì dữ liệu thay đổi thì phải xuất lại Lần 2

Nhưng mà sheet mới đã có tên rồi nên khi xuất lại Báo Cáo nó không tạo được sheet mới vì trùng tên, nhờ mọi người chỉ mình hướng khắc phục bằng cách xóa sheet trùng tên và tạo lại

Ý tưởng của mình là:
Trước khi xuất báo cáo, tìm xem có sheet nào đã có tên theo điều kiện lọc chưa
Nếu có thì xóa hết đi rồi mới làm báo cáo

Mã:

Sub BaoCao() Dim DKLoc As Range 'Khai bao Vung du lieu chua DIEU KIEN de loc du lieu 'Dim VungDL_Loc As Range 'Khai bao Vung de loc du lieu Dim lr As Long 'Bien dong cuoi cua Vung Du Lieu can Loc lr = Sheet1.Cells(Rows.Count, 1).End(3).Row Dim lrDK As Integer 'Bien dong cuoi cua Vung DK loc (cot H la cot 8) lrDK = Sheet1.Cells(Rows.Count, 8).End(3).Row ' Gan vung chua DK loc tu cot H2 den cot H chua dong cuoi Set DKLoc = Sheet1.Range("H2:H" & lrDK) 'Set VungDL_Loc = Sheet1.Range("A1:B" & lr) For Each DKLoc In DKLoc With Sheet1 'Tat AutoFile trong sheet1 truoc da .AutoFilterMode = False ' Loc vung Du Lieu can tinh toan .Range("A1:B" & lr).AutoFilter ' Loc du lieu tai cot 1, dieu kien la gia tri cua vung chua DKLoc .Range("A1:B" & lr).AutoFilter Field:=1, Criteria1:=DKLoc.Value 'Copy du lieu sau khi loc .Range("A1:B" & lr).Parent.AutoFilter.Range.Copy End With 'Tao 1 sheet moi sau sheet cuoi Sheets.Add after:=Sheets(Sheets.Count) 'Dat ten cho sheet moi tao Sheets(Sheets.Count).Name = DKLoc.Value 'Paste du lieu BAO CAO sang sheet moi tao Sheets(Sheets.Count).Range("a1").PasteSpecial xlPasteValues Next DKLoc ' Khong loc du lieu nua Sheet1.AutoFilterMode = False ' Quay ve sheet DATA Sheet1.Select MsgBox "Da xuat xong tat ca cac bao cao" End Sub

Bác thử nhưa thế này xem

PHP:

Public Function WsExit(wsName As String) As Boolean
On Error Resume Next
WsExit = CBool(Len(Worksheets(wsName).Name) > 0)
End Function

PHP:

Sub BaoCao()
    Dim DKLoc As Range          'Khai bao Vung du lieu chua DIEU KIEN de loc du lieu
'Dim VungDL_Loc As Range     'Khai bao Vung de loc du lieu
    Dim lr As Long              'Bien dong cuoi cua Vung Du Lieu can Loc
lr = Sheet1.Cells(Rows.Count, 1).End(3).Row
    Dim lrDK As Integer         'Bien dong cuoi cua Vung DK loc (cot H la cot 8)
lrDK = Sheet1.Cells(Rows.Count, 8).End(3).Row
' Gan vung chua DK loc tu cot H2 den cot H chua dong cuoi
Set DKLoc = Sheet1.Range("H2:H" & lrDK)
'Set VungDL_Loc = Sheet1.Range("A1:B" & lr)
For Each DKLoc In DKLoc
    If WsExit(DKLoc.Value) Then Sheets(DKLoc.Value).Delete          ' <---- THEM DONG NAY
    With Sheet1
        'Tat AutoFile trong sheet1 truoc da
        .AutoFilterMode = False
        ' Loc vung Du Lieu can tinh toan
        .Range("A1:B" & lr).AutoFilter
        ' Loc du lieu tai cot 1, dieu kien la gia tri cua vung chua DKLoc
        .Range("A1:B" & lr).AutoFilter field:=1, Criteria1:=DKLoc.Value
        'Copy du lieu sau khi loc
        .Range("A1:B" & lr).Parent.AutoFilter.Range.Copy
    End With
    'Tao 1 sheet moi sau sheet cuoi
    Sheets.Add after:=Sheets(Sheets.Count)
    'Dat ten cho sheet moi tao
    Sheets(Sheets.Count).Name = DKLoc.Value
    'Paste du lieu BAO CAO sang sheet moi tao
    Sheets(Sheets.Count).Range("a1").PasteSpecial xlPasteValues
Next DKLoc
' Khong loc du lieu nua
Sheet1.AutoFilterMode = False
' Quay ve sheet DATA
Sheet1.Select
MsgBox "Da xuat xong tat ca cac bao cao"
End Sub

sondaubac · 9/10/17

Mình có suy nghĩ được như thế này, Giữa đoạn CODE đó và CODE mình mới làm đây thì cái nào hợp lý hơn vậy Pacific nhỉ

Mã:

Sub BaoCao()
    Dim DKLoc As Range          'Khai bao Vung du lieu chua DIEU KIEN de loc du lieu
    'Dim VungDL_Loc As Range    'Khai bao Vung de loc du lieu
  
    Dim DK1 As Range            ' Khai bao bien DK1 chay trong vung DK Loc
  
    Dim lr As Long              'Bien dong cuoi cua Vung Du Lieu can Loc
    lr = Sheet1.Cells(Rows.Count, 1).End(3).Row
    Dim lrDK As Integer         'Bien dong cuoi cua Vung DK loc (cot H la cot 8)
    lrDK = Sheet1.Cells(Rows.Count, 8).End(3).Row
  
  
    '------------------------------------------------
    ' Gan vung chua DK loc tu cot H2 den cot H chua dong cuoi
    Set DKLoc = Sheet1.Range("H2:H" & lrDK)
  
  
    '------------------------------------------------
    ' Tim cac sheet da co ten theo DK1, xoa het di truoc khi xuat BAO CAO
    Dim ws As Worksheet
  
    Application.DisplayAlerts = False   'Tat thong bao delete sheet
    For Each DK1 In DKLoc
        For Each ws In Worksheets
          
            If ws.Name = DK1.Value Then
                ws.Delete
            End If
      
        Next ws
    Next DK1
    Application.DisplayAlerts = False   'Mo lai thong bao delete sheet
  
  
    '------------------------------------------------
    ' Loc du lieu theo dieu kien va TAO RA cac Sheet de BAO CAO
    For Each DK1 In DKLoc
      
        With Sheet1
      
            'Tat AutoFile trong sheet1 truoc da
            .AutoFilterMode = False
          
            ' Loc vung Du Lieu can tinh toan
            .Range("A1:B" & lr).AutoFilter
          
            ' Loc du lieu tai cot 1, dieu kien la gia tri cua vung chua DKLoc
            .Range("A1:B" & lr).AutoFilter Field:=1, Criteria1:=DK1.Value
          
            'Copy du lieu sau khi loc
            .Range("A1:B" & lr).Parent.AutoFilter.Range.Copy
          
        End With
          
        'Kiem tra su ton tai cua sheet hien huu
        'Neu ton tai sheet trung ten thi xoa sheet dang co va tao sheet moi
        'Neu khong ton tai sheet trung ten thi tao sheet moi lam binh thuong
              
        'Tao 1 sheet moi sau sheet cuoi
        Sheets.Add after:=Sheets(Sheets.Count)
              
        'Dat ten cho sheet moi tao
        Sheets(Sheets.Count).Name = DK1.Value
              
        'Paste du lieu BAO CAO sang sheet moi tao
        Sheets(Sheets.Count).Range("a1").PasteSpecial xlPasteValues
      
    Next DK1
    
    ' Khong loc du lieu nua
    Sheet1.AutoFilterMode = False
  
    ' Quay ve sheet DATA
    Sheet1.Select
    MsgBox "Da xuat xong tat ca cac bao cao"
  
End Sub

PacificPR đã viết:

Bác thử nhưa thế này xem

PHP:

Public Function WsExit(wsName As String) As Boolean
On Error Resume Next
WsExit = CBool(Len(Worksheets(wsName).Name) > 0)
End Function

PHP:

Sub BaoCao()
    Dim DKLoc As Range          'Khai bao Vung du lieu chua DIEU KIEN de loc du lieu
'Dim VungDL_Loc As Range     'Khai bao Vung de loc du lieu
    Dim lr As Long              'Bien dong cuoi cua Vung Du Lieu can Loc
lr = Sheet1.Cells(Rows.Count, 1).End(3).Row
    Dim lrDK As Integer         'Bien dong cuoi cua Vung DK loc (cot H la cot 8)
lrDK = Sheet1.Cells(Rows.Count, 8).End(3).Row
' Gan vung chua DK loc tu cot H2 den cot H chua dong cuoi
Set DKLoc = Sheet1.Range("H2:H" & lrDK)
'Set VungDL_Loc = Sheet1.Range("A1:B" & lr)
For Each DKLoc In DKLoc
    If WsExit(DKLoc.Value) Then Sheets(DKLoc.Value).Delete          ' <---- THEM DONG NAY
    With Sheet1
        'Tat AutoFile trong sheet1 truoc da
        .AutoFilterMode = False
        ' Loc vung Du Lieu can tinh toan
        .Range("A1:B" & lr).AutoFilter
        ' Loc du lieu tai cot 1, dieu kien la gia tri cua vung chua DKLoc
        .Range("A1:B" & lr).AutoFilter field:=1, Criteria1:=DKLoc.Value
        'Copy du lieu sau khi loc
        .Range("A1:B" & lr).Parent.AutoFilter.Range.Copy
    End With
    'Tao 1 sheet moi sau sheet cuoi
    Sheets.Add after:=Sheets(Sheets.Count)
    'Dat ten cho sheet moi tao
    Sheets(Sheets.Count).Name = DKLoc.Value
    'Paste du lieu BAO CAO sang sheet moi tao
    Sheets(Sheets.Count).Range("a1").PasteSpecial xlPasteValues
Next DKLoc
' Khong loc du lieu nua
Sheet1.AutoFilterMode = False
' Quay ve sheet DATA
Sheet1.Select
MsgBox "Da xuat xong tat ca cac bao cao"
End Sub

PacificPR · 9/10/17

2 cái như nhau Bác ạ. Chỉ khác là 1 cái tìm xóa hết rồi bắt đầu tách. Một cái là tách đến đâu tìm xóa đến đó
Mà theo quan điểm của dân thi công thì:
(1) Cách mới của Bác là Quy hoạch xong mới xây dựng
(2) Cách của em là vừa Quy hoạch vừa xây dựng
Từ (1) và (2) => Cách mới của Bác hay hơn

sondaubac · 9/10/17

Cảm ơn PacificPR nha.

Hỏi về xuất lại báo cáo đã có sẵn (1 người xem)

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

sondaubac

Thành viên hoạt động

File đính kèm

PacificPR

Thành viên mới

sondaubac

Thành viên hoạt động

PacificPR

Thành viên mới

sondaubac

Thành viên hoạt động

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

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

Đếm ngược thời gian