Tổng hợp BÁO CÁO từ dữ liệu có sẵn (1 người xem)

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

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
L

levin1

Thành viên mới
Tham gia
18/11/10
Bài viết
44
Được thích
9
Xin chào các thầy và các bạn trên diễn đàn

Mình hiện đang có 1 file theo dõi dữ liệu sản xuất theo các máy được trình bày như sheet "DATA" và cuối tuần sẽ phải báo cáo lên cấp trên theo form mẫu như sheet "TH" .
Mình vẫn thường sử dụng chức năng copy/paste để tổng hợp thành báo cáo nhưng lượng dữ liệu hàng tuần đang tăng lên nhiều nên việc tổng hợp hơi mất thời gian .
Vì vậy ,mong các thầy và các bạn trên diễn đàn có thể dành thời gian giúp mình viết code để có thể ra báo cáo tổng hợp nhanh hơn không
Xin cảm ơn các thầy và các bạn đã đọc bài và giúp đỡ .
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
levin1 đã viết:
Xin chào các thầy và các bạn trên diễn đàn

Mình hiện đang có 1 file theo dõi dữ liệu sản xuất theo các máy được trình bày như sheet "DATA" và cuối tuần sẽ phải báo cáo lên cấp trên theo form mẫu như sheet "TH" .
Mình vẫn thường sử dụng chức năng copy/paste để tổng hợp thành báo cáo nhưng lượng dữ liệu hàng tuần đang tăng lên nhiều nên việc tổng hợp hơi mất thời gian .
Vì vậy ,mong các thầy và các bạn trên diễn đàn có thể dành thời gian giúp mình viết code để có thể ra báo cáo tổng hợp nhanh hơn không
Xin cảm ơn các thầy và các bạn đã đọc bài và giúp đỡ .
Nhấp chuột vào đây để mở rộng...
Mấy cái cột kết quả làm sao tính ra như vậy được bạn
 
Upvote 0
levin1 đã viết:
Xin chào các thầy và các bạn trên diễn đàn

Mình hiện đang có 1 file theo dõi dữ liệu sản xuất theo các máy được trình bày như sheet "DATA" và cuối tuần sẽ phải báo cáo lên cấp trên theo form mẫu như sheet "TH" .
Mình vẫn thường sử dụng chức năng copy/paste để tổng hợp thành báo cáo nhưng lượng dữ liệu hàng tuần đang tăng lên nhiều nên việc tổng hợp hơi mất thời gian .
Vì vậy ,mong các thầy và các bạn trên diễn đàn có thể dành thời gian giúp mình viết code để có thể ra báo cáo tổng hợp nhanh hơn không
Xin cảm ơn các thầy và các bạn đã đọc bài và giúp đỡ .
Nhấp chuột vào đây để mở rộng...
Tổng hợp đầu vào, đầu ra theo máy và quy cách có sẵn trong form TH.
 

File đính kèm

Upvote 0
darknightno007 đã viết:
Mấy cái cột kết quả làm sao tính ra như vậy được bạn
Nhấp chuột vào đây để mở rộng...

Cột kết quả của mình bao gồm
- Cột "Phế liệu B" lấy từ mã "PLB" trong cột "Quy cách 1" bên sheet "DATA" theo mã máy .
- Cột "Phế liệu C" lấy từ mã "PLC" trong cột "Quy cách 1" bên sheet "DATA" theo mã máy .
- Cột "Hiệu suất" = Trọng lượng đầu ra / Trọng lượng đầu vào theo định dạng % .
- Cột "Hao hụt" = 100% - Hiệu Suất
Cảm ơn bạn đã quan tâm .
 
Upvote 0
chucuoi92 đã viết:
Tổng hợp đầu vào, đầu ra theo máy và quy cách có sẵn trong form TH.
Nhấp chuột vào đây để mở rộng...

Cảm ơn bạn chucuoi92 đã viết code giúp mình .
Phần quy cách hàng chi tiết ở dưới mỗi máy trong sheet "TH" nếu được bạn có thể viết code tổng hợp dùm mình luôn được không ?
Bởi vì nếu để vậy thì mình cũng vẫn phải copy/paste quy cách này sang sheet "TH" rồi mới dùng code của bạn được .
Xin lỗi đã làm phiền bạn .
 
Upvote 0
levin1 đã viết:
Cảm ơn bạn chucuoi92 đã viết code giúp mình .
Phần quy cách hàng chi tiết ở dưới mỗi máy trong sheet "TH" nếu được bạn có thể viết code tổng hợp dùm mình luôn được không ?
Bởi vì nếu để vậy thì mình cũng vẫn phải copy/paste quy cách này sang sheet "TH" rồi mới dùng code của bạn được .
Xin lỗi đã làm phiền bạn .
Nhấp chuột vào đây để mở rộng...
Bạn xem tạm file này, màu mè tùy bạn thêm.
 

File đính kèm

Upvote 0
levin1 đã viết:
Xin chào các thầy và các bạn trên diễn đàn

Mình hiện đang có 1 file theo dõi dữ liệu sản xuất theo các máy được trình bày như sheet "DATA" và cuối tuần sẽ phải báo cáo lên cấp trên theo form mẫu như sheet "TH" .
Mình vẫn thường sử dụng chức năng copy/paste để tổng hợp thành báo cáo nhưng lượng dữ liệu hàng tuần đang tăng lên nhiều nên việc tổng hợp hơi mất thời gian .
Vì vậy ,mong các thầy và các bạn trên diễn đàn có thể dành thời gian giúp mình viết code để có thể ra báo cáo tổng hợp nhanh hơn không
Xin cảm ơn các thầy và các bạn đã đọc bài và giúp đỡ .
Nhấp chuột vào đây để mở rộng...
Code mình viết dài dòng quá, bạn thử xem sao:
Mã: 
Sub GPE()
    Dim sArr(), dArr(), tArr, Arr(), Dic As Object, Tem As String
    Dim I As Long, J As Long, K As Long, M As Long, N As Long
    
    sArr() = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown)).Resize(, 6).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 13)
    ReDim Arr(1 To UBound(sArr, 1), 1 To 13)
    Set Dic = CreateObject("Scripting.Dictionary")
    
    For I = 1 To UBound(sArr, 1)
        Tem = sArr(I, 1)
        If Not Dic.exists(Tem) Then
            M = M + 1
            Dic.Add Tem, M
            Arr(M, 1) = Tem
            If sArr(I, 5) <> 0 Then
                Arr(M, 3) = sArr(I, 5): Arr(M, 4) = sArr(I, 6)
            Else
                If sArr(I, 3) = 0 Then
                    If sArr(I, 2) = "PLB" Then
                        Arr(M, 9) = sArr(I, 4)
                    Else
                        Arr(M, 10) = sArr(I, 4)
                    End If
                Else
                    Arr(M, 7) = sArr(I, 3): Arr(M, 8) = sArr(I, 4)
                End If
            End If
        Else
            If sArr(I, 5) <> 0 Then
                Arr(Dic.Item(Tem), 3) = Arr(Dic.Item(Tem), 3) + sArr(I, 5)
                Arr(Dic.Item(Tem), 4) = Arr(Dic.Item(Tem), 4) + sArr(I, 6)
            Else
                If sArr(I, 3) = 0 Then
                    If sArr(I, 2) = "PLB" Then
                        Arr(Dic.Item(Tem), 9) = Arr(Dic.Item(Tem), 9) + sArr(I, 4)
                    Else
                        Arr(Dic.Item(Tem), 10) = Arr(Dic.Item(Tem), 10) + sArr(I, 4)
                    End If
                Else
                    Arr(Dic.Item(Tem), 7) = Arr(Dic.Item(Tem), 7) + sArr(I, 3)
                    Arr(Dic.Item(Tem), 8) = Arr(Dic.Item(Tem), 8) + sArr(I, 4)
                End If
            End If
        End If
    Next I
    tArr = Dic.keys
    For J = 0 To UBound(tArr)
        K = K + 1
        N = K
        For M = 1 To 10
            dArr(K, M) = Arr(Dic.Item(tArr(J)), M)
        Next M
        dArr(K, 11) = Arr(Dic.Item(tArr(J)), 8) / Arr(Dic.Item(tArr(J)), 4)
        dArr(K, 12) = 1 - dArr(K, 11)
        For I = 1 To UBound(sArr, 1)
            If sArr(I, 1) = tArr(J) Then
                If sArr(I, 5) <> 0 Then
                    K = K + 1
                    dArr(K, 2) = sArr(I, 2): dArr(K, 3) = sArr(I, 5): dArr(K, 4) = sArr(I, 6)
                Else
                    If sArr(I, 3) <> 0 Then
                        N = N + 1
                        dArr(N, 6) = sArr(I, 2): dArr(N, 7) = sArr(I, 3): dArr(N, 8) = sArr(I, 4)
                    End If
                End If
            End If
        Next I
    Next J
    If K > N Then
        Sheet2.Range("A9").Resize(K, 13).ClearContents
        Sheet2.Range("A9").Resize(K, 13) = dArr
    Else
        Sheet2.Range("A9").Resize(N, 13).ClearContents
        Sheet2.Range("A9").Resize(N, 13) = dArr
    End If
    Set Dic = Nothing
    MsgBox "Done", vbInformation, "GPE"
End Sub
 
Upvote 0
vanthinh3101 đã viết:
Code mình viết dài dòng quá, bạn thử xem sao:
Mã: 
Sub GPE()
    Dim sArr(), dArr(), tArr, Arr(), Dic As Object, Tem As String
    Dim I As Long, J As Long, K As Long, M As Long, N As Long
   
    sArr() = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown)).Resize(, 6).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 13)
    ReDim Arr(1 To UBound(sArr, 1), 1 To 13)
    Set Dic = CreateObject("Scripting.Dictionary")
   
    For I = 1 To UBound(sArr, 1)
        Tem = sArr(I, 1)
        If Not Dic.exists(Tem) Then
            M = M + 1
            Dic.Add Tem, M
            Arr(M, 1) = Tem
            If sArr(I, 5) <> 0 Then
                Arr(M, 3) = sArr(I, 5): Arr(M, 4) = sArr(I, 6)
            Else
                If sArr(I, 3) = 0 Then
                    If sArr(I, 2) = "PLB" Then
                        Arr(M, 9) = sArr(I, 4)
                    Else
                        Arr(M, 10) = sArr(I, 4)
                    End If
                Else
                    Arr(M, 7) = sArr(I, 3): Arr(M, 8) = sArr(I, 4)
                End If
            End If
        Else
            If sArr(I, 5) <> 0 Then
                Arr(Dic.Item(Tem), 3) = Arr(Dic.Item(Tem), 3) + sArr(I, 5)
                Arr(Dic.Item(Tem), 4) = Arr(Dic.Item(Tem), 4) + sArr(I, 6)
            Else
                If sArr(I, 3) = 0 Then
                    If sArr(I, 2) = "PLB" Then
                        Arr(Dic.Item(Tem), 9) = Arr(Dic.Item(Tem), 9) + sArr(I, 4)
                    Else
                        Arr(Dic.Item(Tem), 10) = Arr(Dic.Item(Tem), 10) + sArr(I, 4)
                    End If
                Else
                    Arr(Dic.Item(Tem), 7) = Arr(Dic.Item(Tem), 7) + sArr(I, 3)
                    Arr(Dic.Item(Tem), 8) = Arr(Dic.Item(Tem), 8) + sArr(I, 4)
                End If
            End If
        End If
    Next I
    tArr = Dic.keys
    For J = 0 To UBound(tArr)
        K = K + 1
        N = K
        For M = 1 To 10
            dArr(K, M) = Arr(Dic.Item(tArr(J)), M)
        Next M
        dArr(K, 11) = Arr(Dic.Item(tArr(J)), 8) / Arr(Dic.Item(tArr(J)), 4)
        dArr(K, 12) = 1 - dArr(K, 11)
        For I = 1 To UBound(sArr, 1)
            If sArr(I, 1) = tArr(J) Then
                If sArr(I, 5) <> 0 Then
                    K = K + 1
                    dArr(K, 2) = sArr(I, 2): dArr(K, 3) = sArr(I, 5): dArr(K, 4) = sArr(I, 6)
                Else
                    If sArr(I, 3) <> 0 Then
                        N = N + 1
                        dArr(N, 6) = sArr(I, 2): dArr(N, 7) = sArr(I, 3): dArr(N, 8) = sArr(I, 4)
                    End If
                End If
            End If
        Next I
    Next J
    If K > N Then
        Sheet2.Range("A9").Resize(K, 13).ClearContents
        Sheet2.Range("A9").Resize(K, 13) = dArr
    Else
        Sheet2.Range("A9").Resize(N, 13).ClearContents
        Sheet2.Range("A9").Resize(N, 13) = dArr
    End If
    Set Dic = Nothing
    MsgBox "Done", vbInformation, "GPE"
End Sub
Nhấp chuột vào đây để mở rộng...
Rất tuyệt vời .Cảm ơn bác đã giúp em .
Chúc bác và mọi người trên diễn đàn sức khỏe
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

V
  • Question Question
Đếm xếp loại của đơn hàng (2 người xem)
Trả lời
5
Đọc
66
hoanganhvo2612
H
Manhhung90
Thoát chế độ Read only file word. Nhờ mọi người giúp ạ (4 người xem)
Trả lời
5
Đọc
49
Manhhung90
Manhhung90
phatnguyen7301
  • Question Question
Viết code không trùng dữ liệu (7 người xem)
Trả lời
0
Đọc
4
phatnguyen7301
phatnguyen7301
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng theo điều kiện cho trước.
Trả lời
3
Đọc
71
hanhnguyen12022021
H
N
Không chạy được file VBA (1 người xem)
Trả lời
2
Đọc
79
hoangtuan.net
hoangtuan.net
H
Quản Lý Công Văn đi Và đến
9 10 11
Trả lời
214
Đọc
158K
ptm0412
ptm0412
T
Em muốn xin chỉ giáo file excel theo dõi thu chi, lãi lỗ của từng xe để báo cáo ạ (1 người xem)
Trả lời
3
Đọc
71
VetMini
V
S
RemoveDuplicates Adodb VBA
Trả lời
0
Đọc
65
sykika
S
G
  • Question Question
BẢO MẬT VBAPROJECT
Trả lời
0
Đọc
111
giaoluu1231
G
sangvanng92
  • Question Question
Phân quyền user truy cập
Trả lời
9
Đọc
170
Hoàng Tuấn 868
H
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
7
Đọc
145
DinhManh1307
DinhManh1307
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
6
Đọc
302
tranhungdao12a3
T
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365 (1 người xem)
Trả lời
0
Đọc
1K
GPE-Trợ Lý
GPE-Trợ Lý
befaint
Chia sẻ tâm tư, xả nỗi lòng
    • Thích
36 37 38
Trả lời
759
Đọc
49K
befaint
befaint
H
Quên mật khẩu khóa protect
Trả lời
18
Đọc
270
HeSanbi
HeSanbi
NguyenNgocThuHien
  • Question Question
Liệt kê tổ hợp chập k của nhóm n phần tử.
    • Thích
    • Yêu thích
2 3
Trả lời
54
Đọc
17K
phương Đức
P
T
  • Question Question
Tìm này không xuất hiện trong khoảng thời gian
Trả lời
7
Đọc
109
tuan16
T
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
5
Đọc
193
befaint
befaint
nghiahandsome1995
Xin mã code autofit
Trả lời
4
Đọc
150
yaaasoo01
Y
tuankieu28
Hỗ trợ sửa hàm tìm thông tin
Trả lời
1
Đọc
48
thuytrangbp28
T
Xem thêm…

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

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom