Cập nhật dữ liệu từ sheet phụ sang sheet tổng (2 người xem)

Gà Công Nghệ · 12/1/26

Nhờ Anh chị hỗ trợ giùm em cập nhật từ sheet phụ sang sheet tổng (Sheet phụ của 1 ngày nào đó mà có thêm hay chỉnh sửa gì thì sheet tổng sẽ cập nhật theo). Em xin cám ơn nhiều!

chiendich · 12/1/26

Gà Công Nghệ đã viết:
Nhờ Anh chị hỗ trợ giùm em cập nhật từ sheet phụ sang sheet tổng (Sheet phụ của 1 ngày nào đó mà có thêm hay chỉnh sửa gì thì sheet tổng sẽ cập nhật theo). Em xin cám ơn nhi

Bạn kiểm tra xem!

Mã:

Option Explicit

Public Sub Tonghop()
Application.ScreenUpdating = False
Const MaxR As Long = 1000
Dim Dic As Object, Ws As Worksheet, tArr(), dArr(1 To MaxR, 1 To 6)
Dim I As Long, K As Long, R As Long, Rws As Long, Tmp As String, MyName As String, TT As String, TA As String
    Set Dic = CreateObject("Scripting.Dictionary")
    MyName = "TONG"
    TT = "TRANG_CHU"
    TA = "Sheet1"
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> MyName And Ws.Name <> TT And Ws.Name <> TA Then
        tArr = Ws.Range("B3", Ws.Range("B3").End(xlDown)).Resize(, 5).Value2
        R = UBound(tArr)
        For I = 1 To R
            Tmp = tArr(I, 1) & "#" & tArr(I, 2)
            If Not Dic.Exists(Tmp) Then
                K = K + 1
                Dic.Item(Tmp) = K
                dArr(K, 1) = K
                dArr(K, 2) = tArr(I, 1)
                dArr(K, 3) = tArr(I, 2)
                dArr(K, 4) = tArr(I, 3)
                dArr(K, 5) = tArr(I, 4)
                dArr(K, 6) = tArr(I, 5)
            Else
                Rws = Dic.Item(Tmp)
                dArr(Rws, 4) = dArr(Rws, 4) + tArr(I, 3)
            End If
        Next I
    End If
Next Ws
With Sheets(MyName)
    .Range("A3").Resize(MaxR, 6).ClearContents
    .Range("A3").Resize(K, 6) = dArr
    .Range("A3").Resize(K, 6).Borders.LineStyle = 1
End With
Set Dic = Nothing
End Sub

dungpham01 · 12/1/26

Mã:

=DROP(REDUCE("";SEQUENCE(31);LAMBDA(a;b;IF(ISNA(SHEET(b));a;VSTACK(a;LET(x;TRIMRANGE(INDIRECT(b&"!B3:F1000"));FILTER(x;CHOOSECOLS(x;1)>0))))));1)

nếu có office 365 thì dùng công thức đơn giản

thanthanhan · 12/1/26

Nếu Office 2024 hoặc 365 thì gõ công thức ô B3 trong sheet TONG :
=FILTER(VSTACK('5:31'!B3:F300),VSTACK('5:31'!B3:B300)<>"")

le_vis · Thứ ba lúc 07:22

Gà Công Nghệ đã viết:
Nhờ Anh chị hỗ trợ giùm em cập nhật từ sheet phụ sang sheet tổng (Sheet phụ của 1 ngày nào đó mà có thêm hay chỉnh sửa gì thì sheet tổng sẽ cập nhật theo). Em xin cám ơn nhiều!

Bạn thử cách làm này : Nhập dữ liệu vào Form ===> lưu sang Data_LT. Khi muốn lấy xem lại hoặc in dữ liệu của ngày nào thì gọi về báo cáo để xem lại hoặc in

Gà Công Nghệ · Thứ ba lúc 14:52

le_vis đã viết:
Bạn thử cách làm này : Nhập dữ liệu vào Form ===> lưu sang Data_LT. Khi muốn lấy xem lại hoặc in dữ liệu của ngày nào thì gọi về báo cáo để xem lại hoặc in

Vâng, cám ơn bạn rất nhiều.

Bài đã được tự động gộp: Thứ ba lúc 14:53

chiendich đã viết:

Bạn kiểm tra xem!

Mã:

Option Explicit

Public Sub Tonghop()
Application.ScreenUpdating = False
Const MaxR As Long = 1000
Dim Dic As Object, Ws As Worksheet, tArr(), dArr(1 To MaxR, 1 To 6)
Dim I As Long, K As Long, R As Long, Rws As Long, Tmp As String, MyName As String, TT As String, TA As String
    Set Dic = CreateObject("Scripting.Dictionary")
    MyName = "TONG"
    TT = "TRANG_CHU"
    TA = "Sheet1"
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> MyName And Ws.Name <> TT And Ws.Name <> TA Then
        tArr = Ws.Range("B3", Ws.Range("B3").End(xlDown)).Resize(, 5).Value2
        R = UBound(tArr)
        For I = 1 To R
            Tmp = tArr(I, 1) & "#" & tArr(I, 2)
            If Not Dic.Exists(Tmp) Then
                K = K + 1
                Dic.Item(Tmp) = K
                dArr(K, 1) = K
                dArr(K, 2) = tArr(I, 1)
                dArr(K, 3) = tArr(I, 2)
                dArr(K, 4) = tArr(I, 3)
                dArr(K, 5) = tArr(I, 4)
                dArr(K, 6) = tArr(I, 5)
            Else
                Rws = Dic.Item(Tmp)
                dArr(Rws, 4) = dArr(Rws, 4) + tArr(I, 3)
            End If
        Next I
    End If
Next Ws
With Sheets(MyName)
    .Range("A3").Resize(MaxR, 6).ClearContents
    .Range("A3").Resize(K, 6) = dArr
    .Range("A3").Resize(K, 6).Borders.LineStyle = 1
End With
Set Dic = Nothing
End Sub

code này mình dán vô đâu để tự cập nhật bạn.

Bài đã được tự động gộp: Thứ ba lúc 14:56

dungpham01 đã viết:
Mã:

=DROP(REDUCE("";SEQUENCE(31);LAMBDA(a;b;IF(ISNA(SHEET(b));a;VSTACK(a;LET(x;TRIMRANGE(INDIRECT(b&"!B3:F1000"));FILTER(x;CHOOSECOLS(x;1)>0))))));1)

nếu có office 365 thì dùng công thức đơn giản

file này mình mở lên thì báo lỗi #Name của cột ngày ở sheet TONG

dungpham01 · Thứ ba lúc 15:05

vậy là bạn không có office 365 rồi. còn code trên thì ng ta không viết trên sự kiện nên bạn phải tự tạo 1 nút bấm. khi cần cập nhật dữ liệu thì phải bấm nút

Gà Công Nghệ đã viết:
file này mình mở lên thì báo lỗi #Name của cột ngày ở sheet TONG

Gà Công Nghệ · Thứ ba lúc 15:26

le_vis đã viết:
Bạn thử cách làm này : Nhập dữ liệu vào Form ===> lưu sang Data_LT. Khi muốn lấy xem lại hoặc in dữ liệu của ngày nào thì gọi về báo cáo để xem lại hoặc in

Bạn cho mình hỏi thêm là ở sheet Data_LT mà lỡ bấm nút Xóa_Data thì có cách nào sao khi bấm nút xóa thì dữ liệu sẽ lưu vô 1 sheet khác không à.

chiendich · Thứ ba lúc 17:18

Gà Công Nghệ đã viết:
code này mình dán vô đâu để tự cập nhật bạn.

Dán cái này vào trong ThisWorkbook:

Mã:

Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Select Case Sh.Name
        Case "TONG"
            Call Tonghop
    End Select
End Sub

le_vis · Thứ ba lúc 19:33

Gà Công Nghệ đã viết:
Bạn cho mình hỏi thêm là ở sheet Data_LT mà lỡ bấm nút Xóa_Data thì có cách nào sao khi bấm nút xóa thì dữ liệu sẽ lưu vô 1 sheet khác không à.

Mình chưa thử - Có lẽ được; Nhưng minh làm nút Xoa_Data là nhằm để bạn xoá sạch để làm mẫu cho CSDL mới mà thôi

Gà Công Nghệ · Thứ ba lúc 20:47

le_vis đã viết:
Mình chưa thử - Có lẽ được; Nhưng minh làm nút Xoa_Data là nhằm để bạn xoá sạch để làm mẫu cho CSDL mới mà thôi

Vâng, khi nào bạn rảnh bạn thử làm giùm mình với.

Gà Công Nghệ · Thứ tư lúc 11:10

sao mình thử dán code vô mà không có chạy à bạn. Bạn xem lại hộ giùm với.

chiendich đã viết:
Dán cái này vào trong ThisWorkbook:

Mã:

Option Explicit Private Sub Workbook_SheetActivate(ByVal Sh As Object) Select Case Sh.Name Case "TONG" Call Tonghop End Select End Sub

chiendich · Thứ tư lúc 12:47

Mình đã làm luôn cho bạn trong file nhé!

Gà Công Nghệ · Thứ tư lúc 13:57

chiendich đã viết:
Mình đã làm luôn cho bạn trong file nhé!

Vâng, bạn cho hỏi thêm sheet TONG từ ngày 5 đến ngày 12 thì định dạng là tháng ngày năm, từ ngày 13 trở đi là ngày tháng năm. Mình định dạng ngày tháng năm hết lại không được.

chiendich · Thứ tư lúc 14:21

Bạn thêm đoạn này sau dòng: .Range("A3").Resize(K, 6).Borders.LineStyle = 1

Mã:

.Range("B3").Resize(K, 1).NumberFormat = "dd/mm/yyyy"

Gà Công Nghệ · Thứ năm lúc 07:12

chiendich đã viết:
Bạn thêm đoạn này sau dòng: .Range("A3").Resize(K, 6).Borders.LineStyle = 1

Mã:

.Range("B3").Resize(K, 1).NumberFormat = "dd/mm/yyyy"

Vâng à, cám ơn bạn rất nhiều.

Cập nhật dữ liệu từ sheet phụ sang sheet tổng (2 người xem)

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

Thành viên mới

File đính kèm

Lỡ bước sang ngang

Thành viên chính thức

File đính kèm

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

Thành viên tích cực

File đính kèm

Thành viên mới

Thành viên chính thức

Thành viên mới

Lỡ bước sang ngang

Thành viên tích cực

Thành viên mới

Thành viên mới

Lỡ bước sang ngang

File đính kèm

Thành viên mới

Lỡ bước sang ngang

Thành viên mới

Thời gian đếm ngược.