Tự động chia tách dữ liệu ra các sheet khác nhau

Liên hệ QC

bongco

Thành viên mới
Tham gia
25/9/09
Bài viết
4
Được thích
0
Tôi có một sheet tổng hợp các mặt hàng xuất nhập hàng ngày, nay muốn tách mỗi mặt hàng ra một sheet khác nhau có sự phân tách nhập và xuất.
Hàng ngày, nếu cập nhật thêm dữ liệu vào sheet tổng hợp thì nó cũng tự động cập nhật vào sheet có mã hàng tương ứng vào phần xuất hoặc nhập, mà không cần copy sang.
Và nếu có thể thêm mặt hàng mới tương tự.
Tôi gửi kèm file.
Các bạn giúp tôi với.
Tôi không thể gửi được file đính kèm nó cứ nói là failed.
Các bạn hướng dẫn giúp tôi với.
 
Lần chỉnh sửa cuối:
Tôi có một sheet tổng hợp các mặt hàng xuất nhập hàng ngày, nay muốn tách mỗi mặt hàng ra một sheet khác nhau có sự phân tách nhập và xuất.
Hàng ngày, nếu cập nhật thêm dữ liệu vào sheet tổng hợp thì nó cũng tự động cập nhật vào sheet có mã hàng tương ứng vào phần xuất hoặc nhập, mà không cần copy sang.
Và nếu có thể thêm mặt hàng mới tương tự.
Tôi gửi kèm file.
Các bạn giúp tôi với.
Nếu bạn không gửi file lên được, bạn có thể gửi vào địa chỉ david@dowell-plus.co.kr
Tôi sẽ up lên giúp bạn.
 
Mời các bạn xem file giúp giùm nhé
Nhập liệu như thế là khá chuẩn rồi ---> Nhưng phần yêu cầu tách ra từng sheet thì quả thật hơi.. tào lao
Dùng PivotTable thì muốn gì mà chẳng được ---> Giả định rằng bạn có 1000 mặt hàng, vậy bạn định tách ra 1000 sheet sao ---> Với dử liệu được tổng hợp bằng PivotTable, bạn thích trích cái gì thì cứ chọn cái đấy (trong file bạn đang áp dụng, tại sao không phát huy)
domfootwear DOSNET là cao thủ về mặt này, các bạn trổ tài giúp nhé
 
Xin giới thiệu một phương cách của VBA

PHP:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 On Error GoTo Loi
 If Not Intersect(Target, Columns("I")) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range, sRng As Range
   Dim TTr As String, Ten As String:            Dim SoDg As Long
   
   Ten = Target.Offset(, -6).Value
   Set Sh = Sheets(Ten):                        Ten = Left(Ten, 1)
   If UCase$(Left(Target.Offset(, -1), 1)) = "N" Then
      TTr = "N"
   ElseIf UCase$(Left(Target.Offset(, -1), 1)) = "X" Then
      TTr = "X"
   End If
   Set Rng = Sh.Range(Sh.[h4], Sh.[H65500].End(xlUp).Offset(9))
   Set sRng = Rng.Find(TTr, , xlFormulas, xlPart)
   If sRng Is Nothing Then
      MsgBox "Chua Viet. . . ", , "GPE.COM Xin Luu Y:"
   Else
      Set sRng = sRng.End(xlDown)
      With sRng
         .Offset(1).EntireRow.Insert
         .Offset(1, -6).Resize(, 8).Value = Target.Offset(, -7).Resize(, 8).Value
      End With
      Target.Interior.ColorIndex = 34 + ((Asc(TTr) + Asc(Ten)) Mod 6)
      If TTr = "N" Then
         SoDg = sRng.Row - 3
      Else
         SoDg = sRng.Row - sRng.End(xlUp).Row + 2
      End If
      sRng.Offset(2, -1).FormulaR1C1 = "=SUM(R[-" & SoDg & "]C:R[-1]C)"
   End If
   
 End If
Err_:                Exit Sub
Loi:                 MsgBox Error$, , sRng.Address
   GoTo Err_
End Sub

Chú ý khi sử dụng:
Mình chỉ chịu trách nhiệm về sự đúng đắn của macro, một khi bạn tăng số trang tính thêm nữa chỉ bằng cách nhân bản từ trang 'HC' (mình tô đỏ rồi đó) & sửa lại tên từ bản nhân.
 

File đính kèm

  • GPE.rar
    19.8 KB · Đọc: 111
Còn đây là cách hiện kết quả lên chỉ 1 trang tính bằng VBA

PHP:
Sub BaoCao(MaHg As String)
 Dim Sh As Worksheet, Rng As Range, Clls As Range, sRng As Range
 Dim MyAdd As String:               Dim SoDg As Integer, Dong As Integer, jJ As Byte
 
 Set Rng = Range([c4], [c65500].End(xlUp)):        Set Sh = Sheets("BC")
 Sh.Range(Sh.[B5], Sh.[b65500].End(xlUp).Offset(9)).Resize(, 8).Clear
 Set sRng = Rng.Find(MaHg, , xlFormulas, xlWhole)
 If Not sRng Is Nothing Then
   MyAdd = sRng.Address
   For jJ = 1 To 2
      Do
         If (jJ = 1 And UCase$(Left(sRng.Offset(, 5), 1)) = "N") Or _
            (jJ = 2 And UCase$(Left(sRng.Offset(, 5), 1)) = "X") Then
         
            Sh.[E65500].End(xlUp).Offset(1, -3).Resize(, 8).Value = _
               sRng.Offset(, -1).Resize(, 8).Value
         End If
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      If jJ = 1 Then
         With Sh.[E65500].End(xlUp)
            SoDg = .Row - 4
            .Offset(1).FormulaR1C1 = "=SUM(R[-" & SoDg & "]C:R[-1]C)"
            .Offset(1, 2).FormulaR1C1 = "=SUM(R[-" & SoDg & "]C:R[-1]C)"
            .Offset(1, -1).Value = Sh.[g4].Value:        Dong = .Row + 1
            .Offset(1, -1).Resize(, 4).Font.Bold = True
         End With
      Else
         With Sh.[E65500].End(xlUp)
            SoDg = .Row - Dong
            .Offset(1).FormulaR1C1 = "=SUM(R[-" & SoDg & "]C:R[-1]C)"
            .Offset(1, 2).FormulaR1C1 = "=SUM(R[-" & SoDg & "]C:R[-1]C)"
            .Offset(1, -1).Value = Sh.[g4].Value
            .Offset(2, -1).FormulaR1C1 = "=Ton"
            .Offset(2, 2).FormulaR1C1 = "=R[-" & (.Row - Dong + 2) & "]C-R[-1]C"
            .Offset(1, -1).Resize(2, 4).Font.Bold = True
         End With
      End If
   Next jJ
 End If
 Sh.Select:                   Set Sh = Nothing
End Sub
Hướng dẫn sử dụng:

Chọn mã loại hương liệu cần hiện trên trang 'BC' tại trang 'TongHop![F1]'
(Xem trong file kèm theo)
 

File đính kèm

  • GPE.rar
    24 KB · Đọc: 92
Dùng PivotTable

Theo như thầy Ndu96081631 đã đề cập, mình dùng PivotTable cho nó dể và hiệu quả.
Để cho PivotTable cập nhật 1 cách tự động mỗi khi click qua, bạn thêm code sau vào phần Worksheet_Activate của sheet có chứa Pivot đó là được.

Mã:
Private Sub Worksheet_Activate()
Sheet5.PivotTables("PivotTable2").PivotCache.Refresh
End Sub

Bạn muốn mặt hàng nào thì cứ việc chọn mặt hàng đó ra thôi.

Bạn tham khảo thêm file nhé.
 

File đính kèm

  • Mua1.rar
    14.9 KB · Đọc: 109
Thì cũng mong muốn giảm bớt công việc đi nếu có thể, Tôi làm cái pivot thì cũng chưa hiểu nhiều về nó lắm, thấy nhiều có lúc một mặt hàng hiện ra nhiều lần (ví dụ hương sữa nó hiện ra 5 - 20 - 15), hoặc nó chỉ hiện một lần nhưng cũng không phải tổng cộng số lượng (ví dụ KAKAO là 175 nhưng chỉ hiện 25) Thành tiên thì vẫn đúng vì sao vậy? . tôi rất ít kiến thức về excel nhờ các bạn chỉ giúp.
Có thể trong EXCEL tự động copy 1 dòng dữ liệu từ sheet mới nhập qua sheet khác không?

 
Lần chỉnh sửa cuối:
Web KT
Back
Top Bottom