dùng VBA để báo cáo từ ngày đến ngày (7 người xem)

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

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

quykh

Chim non
Tham gia
7/9/11
Bài viết
381
Được thích
46
Giới tính
Nữ
Nghề nghiệp
Công Nhân
Chào gia đình GPE, em có 1 file này mong nhà ta viết code để báo cáo từ ngày đến ngày mà kết quả tính tổng theo tên phụ liệu.Vì dùng hàm thì thấy nó chậm quá.
 

File đính kèm

Chào gia đình GPE, em có 1 file này mong nhà ta viết code để báo cáo từ ngày đến ngày mà kết quả tính tổng theo tên phụ liệu.Vì dùng hàm thì thấy nó chậm quá.

Thế sao không dùng PivotTable cho nó khỏe? Cần gì phải code!
 
Em không biết gì về VBA và PivotTable hết Thầy ơi!
 
Em cám ơn Thầy, nhưng sao trong mục ngày của Thầy chỉ tới 6/1/2012 mà file là tới 7/2/2012 lựn mà Thầy. Nhưng cũng chưa đúng ý em Thầy ơi. Tức là em muốn như đầu đề là từ ngày đến ngày cơ(có thể là 10 ngày ,01 tháng hoặc 03 tháng). Em mong Thầy và GPE giúp em.
 
Em cám ơn Thầy, nhưng sao trong mục ngày của Thầy chỉ tới 6/1/2012 mà file là tới 7/2/2012 lựn mà Thầy. Nhưng cũng chưa đúng ý em Thầy ơi. Tức là em muốn như đầu đề là từ ngày đến ngày cơ(có thể là 10 ngày ,01 tháng hoặc 03 tháng). Em mong Thầy và GPE giúp em.
Thế bạn đã bấm vào mũi tên xổ xuống như hướng dẫn chưa? Muốn chọn từ ngày nào đến ngày nào, cứ vào đó mà chọn
Hic...
 
Em đã bấm vào nút xổ xuống rồi, nhưng chỉ cho chọn có một ngày thôi,hoặc hết tất cả. Ý của em là muốn chọn ngày như là từ 03/01/2012 đến 06/01/2012 cơ. Mong Thầy chỉ giáo.
 
Em đã bấm vào nút xổ xuống rồi, nhưng chỉ cho chọn có một ngày thôi,hoặc hết tất cả. Ý của em là muốn chọn ngày như là từ 03/01/2012 đến 06/01/2012 cơ. Mong Thầy chỉ giáo.
Đoán không lầm thì bạn đang dùng Excel 2003
Với Excel 2007 và Excel 2010 sẽ cho bạn check thoải mái (xem hình)

Untitled.jpg


Vậy nếu không có điều kiện nâng cấp lên Excel 2010, ta cũng có thể dùng code trích lọc (theo Calendar trong file của bạn)
Dạng bài này có rất nhiều trên diễn đàn rồi ---> Cao thủ nào giúp bạn ấy với nhé (có thể dùng AutoFilter)
 
Xin lỗi Thầy, đúng là em đang xài Excel 2003, và không có điều kiện nâng cấp lên 2007-2010, em có lên diễn đàn và có doawnload bài này của Thầy(http://www.giaiphapexcel.com/forum/member.php?61139-ndu96081631).Trong bài này Thầy có thể chỉnh code lại để không xem theo tên máy nữa và cộng chung SL sản xuất theo tên máy thôi. Em thấy Thầy là cao thủ nhất trong GPE. Mong tin Thầy
 
Xin lỗi Thầy, đúng là em đang xài Excel 2003, và không có điều kiện nâng cấp lên 2007-2010, em có lên diễn đàn và có doawnload bài này của Thầy(http://www.giaiphapexcel.com/forum/member.php?61139-ndu96081631).Trong bài này Thầy có thể chỉnh code lại để không xem theo tên máy nữa và cộng chung SL sản xuất theo tên máy thôi. Em thấy Thầy là cao thủ nhất trong GPE. Mong tin Thầy
Bài nào đâu? Bạn cho lại đường link đi!
Làm lại bài cũ, lười quá!
 
Bài đó nè Thầy, Xin lỗi em có sửa tiêu đề của các sheet cho phù hợp với em. Mong Thầy giúp đỡ!
 

File đính kèm

file gốc của Thầy đây ạ!
 

File đính kèm

file gốc của Thầy đây ạ!
Thế thì theo code trong đó sửa lại 1 tí:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Dk As Range
  On Error Resume Next
  If Not Intersect(Range("C2:C3"), Target) Is Nothing And Target.Count = 1 Then
    Application.ScreenUpdating = False
    Set Dk = Range("C2:C3")
    Range("A6:D10000").ClearContents
    With Sheet2.Range(Sheet2.[A4], Sheet2.[E65536].End(xlUp))
      .Parent.Range("V:Y").Clear
      .AutoFilter 1, ">=" & CDbl(Dk(1)), xlAnd, "<=" & CDbl(Dk(2))
      .Offset(, 1).SpecialCells(12).Copy
      .Parent.Range("V1").PasteSpecial 3
      .AutoFilter
      With .Parent.Range("V1").CurrentRegion
        Range("A6").Consolidate "'" & .Parent.Name & "'!" & .Offset(1).Address(, , 2), 9, 0, 1
        .Resize(, 1).AdvancedFilter 1, , , True
        .Offset(1, 1).Resize(, 1).Copy: Range("B6").PasteSpecial 3
        .Parent.ShowAllData
        .Clear
      End With
    End With
    Target.Select
    Application.ScreenUpdating = True
  End If
End Sub
Bài này ngày xưa dùng AutoFilter + Advanced Filter + Consolidate để tổng hợp! Nếu bây giờ mà làm bài này, đương nhiên tôi sẽ dùng mảng để xử lý nó....
Hic... làm biếng với mấy bài dạng này quá
 

File đính kèm

Làm tiếp bài này bằng Dictionary + Array
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim CritArr, sArray, Arr(), Dic As Object, tmp As String
  Dim fDate As Long, eDate As Long, lR As Long, n As Long
  Dim imVal As Double, exVal As Double
  On Error Resume Next
  If Not Intersect(Range("C2:C3"), Target) Is Nothing And Target.Count = 1 Then
    fDate = CLng(Range("C2").Value)
    eDate = CLng(Range("C3").Value)
    sArray = Sheet2.Range("A5:E10000").Value
    ReDim Arr(1 To UBound(sArray, 1), 1 To 4)
    Set Dic = CreateObject("Scripting.Dictionary")
    Range("A6:D10000").ClearContents
    For lR = 1 To UBound(sArray, 1)
      If Trim(CStr(sArray(lR, 2))) <> "" Then
        If CLng(sArray(lR, 1)) >= fDate And CLng(sArray(lR, 1)) <= eDate Then
          tmp = Trim(CStr(sArray(lR, 2)))
          imVal = CDbl(sArray(lR, 4))
          exVal = CDbl(sArray(lR, 5))
          If Not Dic.Exists(tmp) Then
            n = n + 1
            Dic.Add tmp, n
            Arr(n, 1) = tmp
            Arr(n, 2) = CStr(sArray(lR, 3))
            If imVal > 0 Then Arr(n, 3) = imVal
            If exVal > 0 Then Arr(n, 4) = exVal
          Else
            If imVal > 0 Then Arr(Dic.Item(tmp), 3) = Arr(Dic.Item(tmp), 3) + imVal
            If exVal > 0 Then Arr(Dic.Item(tmp), 4) = Arr(Dic.Item(tmp), 4) + exVal
          End If
        End If
      End If
    Next
    If n Then Range("A6:D6").Resize(n).Value = Arr
  End If
End Sub
 

File đính kèm

Các khái niệm về IntersectTarget,Private tôi chưa từng biết về cách dùng của chúng, xin thày Ndu và mọi người chỉ giúp hộ. Tối hôm nay tôi sẽ gắng học cái này.

Cảm ơn thày Ndu nhiều lắm, đặc biệt là khái niệm Dictionary, qua 2 hôm nghiên cứu dưới sự chỉ dẫn của thày và mọi người đến nay tôi đã có thể hiểu, bắt đầu tự vận dụng được rồi.
 
Các khái niệm về IntersectTarget,Private tôi chưa từng biết về cách dùng của chúng, xin thày Ndu và mọi người chỉ giúp hộ. Tối hôm nay tôi sẽ gắng học cái này.

Cảm ơn thày Ndu nhiều lắm, đặc biệt là khái niệm Dictionary, qua 2 hôm nghiên cứu dưới sự chỉ dẫn của thày và mọi người đến nay tôi đã có thể hiểu, bắt đầu tự vận dụng được rồi.

Trích tạm bài của anh hoangdanh để bạn hiểu rõ
Trong các sự kiện hay gặp như Worksheet_change hay Worksheet_selectionchange... thì target có ý chỉ ô, vùng đang được chọn. VD nếu trong sheet, ô A1 đang được chọn thì target lúc này chỉ ô A1. Target ~ [A1] ~ Range("A1")

Intersect là một phương thức, dùng để xác định giao giữa 2 hay nhiều vùng cho trước, kết quả trả về là true or false.

Giả sử ô B25 đang được chọn. target ~ [B25]

Intersect(Range("B20:C30"), Target)" => True
Intersect(Range("B20:C30"), [B19]) => False

Vấn đề của Private Sub
- Khai báo Private Sub: Sub chỉ dùng riêng trong sheet nơi nó được khai báo.
- Muốn dùng chung cho cả workbook, khai báo Public Sub hoặc Sub
- Muốn dùng chung cho nhiều workbook (đang mở), khai báo Global Sub

P/S: Cá nhân mình nghĩ bạn nên học căn bản về VBA trước để hiểu kỹ hơn trước khi nghiên cứu những thứ nâng cao như Dictionary.
 
Lần chỉnh sửa cuối:
Trích tạm bài của anh hoangdanh để bạn hiểu rõ
\

Intersect là một phương thức, dùng để xác định giao giữa 2 hay nhiều vùng cho trước, kết quả trả về là true or false.

Giả sử ô B25 đang được chọn. target ~ [B25]

Intersect(Range("B20:C30"), Target)" => True
Intersect(Range("B20:C30"), [B19]) => False
Cái thằng Interset không phải trả về kết quả TRUE, FALSE đâu nha ---> Chính xác nó là Range
Ví dụ ta có: Intersect(Range("A1:D10"), Range("C5:F20")) sẽ = Range("C5:D10"), tức là phần chung giữa Range("A1:D10")Range("C5:F20")
 
Cái thằng Interset không phải trả về kết quả TRUE, FALSE đâu nha ---> Chính xác nó là Range
Ví dụ ta có: Intersect(Range("A1:D10"), Range("C5:F20")) sẽ = Range("C5:D10"), tức là phần chung giữa Range("A1:D10")Range("C5:F20")
Hì hì, kyo sơ xuất quá, trích dẫn mà không đọc rõ, với lại cũng xài có chữ Is Nothing quen rồi nên cũng nhầm nữa. Cám ơn chú đã nhắc nhở :D
 
Tôi chưa hiểu tại sao phải dùng CLng. Phải chăng cái này có tác dụng đổi dữ liệu ngày tháng sang số để dễ so sánh? Tại sao không so sánh trực tiếp Range("C2").Value với sArray(lR, 1) mà phải gián tiếp biến đổi (Range("C2").Value thành CLng(Range("C2").Value); sArray(lR, 1) thành CLng(sArray(lR, 1)) làm gì?
 
Web KT

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

Back
Top Bottom