Tách Sheet từ bảng khối lượng tạo phụ lục hợp đồng cho từng trạm

quyenpv · 24/9/21

Em chào anh chị trên diễn đàn!
Lời đầu tiên chúc các anh chị mạnh khỏe, hạnh phúc
Lại một lần nữa em nhờ sự giúp đỡ của các anh chị trong việc tách Sheet từ bảng khối lượng tạo phụ lục hợp đồng cho từng trạm. Em diễn giải cụ thể như sau
- Trong file ban đầu sẽ có 2 Sheet là "PLHD" sẽ lấy tổng khối lượng từ Sheet "Khoiluong" và đơn giá trong Sheet "PLHD" đã được tính sẵn
- Sheet "Khoiluong" sẽ được phân tích bằng tay để tính được tổng khối lượng
Lưu ý: Số đầu việc trong Sheet "PLHD" và Số trạm trong Sheet "Khoiluong" có thể thay đổi tùy thuộc vào từng file
Các anh giúp đỡ em có thể tạo 1 Sheet "PLHD_All" và tách ra từng Sheet như file em đính kèm đã làm vì làm bằng tay số lượng ít thì không vấn đề gì nhưng khối lượng nhiều sẽ rất lâu và không tránh khỏi sai sót số liệu nên mạo muội mong các anh giúp đỡ em
Em cám ơn anh chị nhiều
Ảnh 1: Sheet "PLHD"

Ảnh 2: Sheet "Khoiluong"

Mong muốn
1. Tạo 1 Sheet tổng hợp toàn bộ

Và tách thành từng Sheet riêng biết dựa vào Sheet "Khoiluong" và đơn giá trong Sheet "PLHD"

qtm1987 · 25/9/21

quyenpv đã viết:
Các anh chị giúp em với ạ, đôi khi anh chị thấy ngược đời nhưng lại là điều kiện bắt buộc như trường hợp của em ạ

Bên bộ phận tài chính có lẽ nhiều người hay làm trên sheet để tiện nháp luôn trên sheet đó cộng trừ tính toán lại. Dù file có làm bài bản công thức cụ thể nhưng cứ đưa qua đó là họ cứ cộng trừ lại coi có sai sót gì không. Đây cũng là cách kiểm tra số liệu tuy rằng sẽ tốn thêm thời gian.
Nếu có tách sheet thì chắc lấy value đi cho họ ngồi mò lại công thức

vu_tuan_manh_linh · 25/9/21

quyenpv đã viết:
Dạ em cũng không muốn thế anh, nhưng yêu cầu bắt buộc thế ạ. Tách Sheet có cái lợi trong khâu in ấn sẽ nhanh ạ

Nếu muốn in nhanh thì cho nó cái code in nữa là khỏi cần làm gì ngoài việc bấm 1 cái nút và ngồi lướt face.

Bài đã được tự động gộp: 25/9/21

qtm1987 đã viết:
Bên bộ phận tài chính có lẽ nhiều người hay làm trên sheet để tiện nháp luôn trên sheet đó cộng trừ tính toán lại. Dù file có làm bài bản công thức cụ thể nhưng cứ đưa qua đó là họ cứ cộng trừ lại coi có sai sót gì không. Đây cũng là cách kiểm tra số liệu tuy rằng sẽ tốn thêm thời gian.
Nếu có tách sheet thì chắc lấy value đi cho họ ngồi mò lại công thức

Hình như kế toán ở đâu cũng thế, họ chả tin công thức, họ chỉ tin vào các con số chết. Lọ mọ dò dẫm từng dòng.

SA_DQ · 25/9/21

Bạn lấy cái này chép đè lên cái có trước:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rws As Long, J As Long, TT As Integer, W As Integer, Col As Integer
 Dim Rng As Range, sRng As Range, Arr()
 Dim MaTenCV As String
1 ' Tính Khôi Luong Công Viêc    '
 If Not Intersect(Target, [K3]) Is Nothing Then
    With Sheets("KhoiLuong")
        Rws = .[b999].End(xlUp).Row
        Set Rng = .Range(.[e3], .[e3].End(xlToRight))
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then
            ReDim a00(1 To Rws, 1 To 4):                ReDim aKQ(1 To Rws, 1 To 4)
            [A9].Resize(Rws, 9).ClearContents
            Col = sRng.Column
            For J = 4 To Rws
                If Len(.Cells(J, "B").Value) < 4 Then
                    W = W + 1:                  TT = 0
                    a00(W, 2) = .Cells(J, "B").Value:   a00(W, 3) = .Cells(J, "c").Value
                    aKQ(W, 1) = .Cells(J, Col).Value
                ElseIf Len(.Cells(J, "B").Value) >= 4 And .Cells(J, Col).Value > 0 Then
                    TT = TT + 1:                        W = W + 1
                    a00(W, 1) = TT:                     a00(W, 3) = .Cells(J, "c").Value
                    a00(W, 2) = .Cells(J, "B").Value:   a00(W, 4) = .Cells(J, "D").Value
                    aKQ(W, 1) = .Cells(J, Col).Value
                End If
            Next J
        End If
        [A9].Resize(W, 5).Value = a00()
    End With
2 ' Tính Don Giá Cho Tùng Mã Công Viêc       '
    With Sheets("PLHD")
        Rws = .[B9].CurrentRegion.Rows.Count
        Arr() = .[B9].Resize(Rws, 5).Value
        For J = 1 To UBound(Arr())
            MaTenCV = Arr(J, 1) & "@" & Arr(J, 2)
            For TT = 1 To UBound(a00())
                If MaTenCV = a00(TT, 2) & "@" & a00(TT, 3) Then
                    aKQ(TT, 2) = Arr(J, 5):             aKQ(TT, 3) = aKQ(TT, 1) * aKQ(TT, 2)
                End If
            Next TT
        Next J
    End With
    [F9].Resize(TT, 4).Value = aKQ()
    MsgBox "Xong Rôi!", , "GPE.COM Xin Chào!"
 End If
End Sub

quyenpv · 25/9/21

Dạ mong các anh giúp đỡ thực sự khổ lắm cãi nhau mãi mà vẫn không thể nào nói được với bộ phận tài chính đó ạ

Bài đã được tự động gộp: 25/9/21

SA_DQ đã viết:

Bạn lấy cái này chép đè lên cái có trước:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rws As Long, J As Long, TT As Integer, W As Integer, Col As Integer
 Dim Rng As Range, sRng As Range, Arr()
 Dim MaTenCV As String
1 ' Tính Khôi Luong Công Viêc    '
 If Not Intersect(Target, [K3]) Is Nothing Then
    With Sheets("KhoiLuong")
        Rws = .[b999].End(xlUp).Row
        Set Rng = .Range(.[e3], .[e3].End(xlToRight))
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then
            ReDim a00(1 To Rws, 1 To 4):                ReDim aKQ(1 To Rws, 1 To 4)
            [A9].Resize(Rws, 9).ClearContents
            Col = sRng.Column
            For J = 4 To Rws
                If Len(.Cells(J, "B").Value) < 4 Then
                    W = W + 1:                  TT = 0
                    a00(W, 2) = .Cells(J, "B").Value:   a00(W, 3) = .Cells(J, "c").Value
                    aKQ(W, 1) = .Cells(J, Col).Value
                ElseIf Len(.Cells(J, "B").Value) >= 4 And .Cells(J, Col).Value > 0 Then
                    TT = TT + 1:                        W = W + 1
                    a00(W, 1) = TT:                     a00(W, 3) = .Cells(J, "c").Value
                    a00(W, 2) = .Cells(J, "B").Value:   a00(W, 4) = .Cells(J, "D").Value
                    aKQ(W, 1) = .Cells(J, Col).Value
                End If
            Next J
        End If
        [A9].Resize(W, 5).Value = a00()
    End With
2 ' Tính Don Giá Cho Tùng Mã Công Viêc       '
    With Sheets("PLHD")
        Rws = .[B9].CurrentRegion.Rows.Count
        Arr() = .[B9].Resize(Rws, 5).Value
        For J = 1 To UBound(Arr())
            MaTenCV = Arr(J, 1) & "@" & Arr(J, 2)
            For TT = 1 To UBound(a00())
                If MaTenCV = a00(TT, 2) & "@" & a00(TT, 3) Then
                    aKQ(TT, 2) = Arr(J, 5):             aKQ(TT, 3) = aKQ(TT, 1) * aKQ(TT, 2)
                End If
            Next TT
        Next J
    End With
    [F9].Resize(TT, 4).Value = aKQ()
    MsgBox "Xong Rôi!", , "GPE.COM Xin Chào!"
 End If
End Sub

Dạ bị lỗi chỗ này anh

SA_DQ · 25/9/21

Để khử các con số 0 & dòng cuối, bạn sửa dùm mình câu lệnh gần cuối thành

[F9].Resize(W, 4).Value = aKQ()

quyenpv · 25/9/21

SA_DQ đã viết:
Để khử các con số 0 & dòng cuối, bạn sửa dùm mình câu lệnh gần cuối thành

[F9].Resize(W, 4).Value = aKQ()

Trường hợp muốn đưa kết quả vào Sheet Tổng thì sao ạ, anh giúp em với

Bài đã được tự động gộp: 25/9/21

Trường hợp cột mã trạm trong Sheet "Khoiluong" mình có thể tạo luôn Name động được không anh không phải dùng thêm Sheet Phụ nữa ạ

SA_DQ · 25/9/21

1./ Bạn muốn được số liệu trạm nào thì xào tổng của nó vô Sheet tổng, hay phải tính hết cho các trạm trong 1 lần?
2./ Tạo name động bạn hoàn toàn có thể thử; chuyện này có khi mình dỡ hơn bạn nữa là đằng khác!
3./ Nếu trong trang 'KhoiLuong' có cột đơn giá thì đỡ hơn bao nhiêu!

Chúc mọi người vui khỏe!

quyenpv · 25/9/21

SA_DQ đã viết:
1./ Bạn muốn được số liệu trạm nào thì xào tổng của nó vô Sheet tổng, hay phải tính hết cho các trạm trong 1 lần?
2./ Tạo name động bạn hoàn toàn có thể thử; chuyện này có khi mình dỡ hơn bạn nữa là đằng khác!
3./ Nếu trong trang 'KhoiLuong' có cột đơn giá thì đỡ hơn bao nhiêu!

Chúc mọi người vui khỏe!

1. Dạ tính hết trong 1 lần ạ, vừa tách Sheet và đưa giá trị ra Sheet Tổng ạ
2. Nếu tiện anh có thể đưa cột đơn giá sang Sheet Khoiluong ạ

quyenpv · 25/9/21

Các anh chị ơi, giúp em với nhé

SA_DQ · 25/9/21

Bạn kiểm theo file:

quyenpv · 25/9/21

SA_DQ đã viết:
Bạn kiểm theo file:

Dạ không đúng kết quả anh
Trong Sheet PLHD_All em đã link kết qur bằng tay đó ạ

SA_DQ · 25/9/21

Thử lần nữa xem sao, hên sui nha!

quyenpv · 25/9/21

SA_DQ đã viết:
Thử lần nữa xem sao, hên sui nha!

Dạ cám ơn anh
Còn 1 lỗi là tại trạm VTU0199 không có dữ liệu nhưng Code vẫn tính ra giá tiền, anh sửa giúp em với nhé

SA_DQ · 26/9/21

Mã:

Sub TongHopDuLieu()
 Dim Cls As Range, Rng As Range, sRng As Range, Arr(), Sh As Worksheet
 Dim Rws As Long, J As Long, W As Integer, Col As Integer, TT As Integer, Cot As Integer
 Dim MaTr As String, Tong As Double
 On Error GoTo LoiCT
 
 With Sheets("KhoiLuong")
    Rws = .[b999].End(xlUp).Row
    Set Rng = .Range(.[e3], .[e3].End(xlToRight))
    
    For Each Cls In Range([B9], [B9].End(xlDown))
        ReDim Arr(1 To Rws, 1 To 8):                        W = 0
        MaTr = Cls.Value:                                   Cls.Interior.ColorIndex = 2
        Set sRng = Rng.Find(MaTr, , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then
            Col = sRng.Column:                              TT = 0
            W = 0
            For J = 4 To Rws                                'Duyêt Tìm Dòng Có Sô Liêu    '
                If Len(.Cells(J, "B").Value) < 4 Then
                    W = W + 1:
                    Arr(W, 2) = .Cells(J, "B").Value:       Arr(W, 3) = .Cells(J, "c").Value
                    If .Cells(J, "E").Value > 0 Then
                        Arr(W, 5) = .Cells(J, "E").Value    'Don Giá        '
                        Arr(W, 6) = .Cells(J, Col).Value:   Arr(W, 7) = Arr(W, 5) * Arr(W, 6)
                        Tong = Tong + Arr(W, 6)
                    End If
                End If
                If Len(.Cells(J, "B").Value) >= 4 And .Cells(J, Col).Value > 0 Then
                    TT = TT + 1:                            W = W + 1
                    Arr(W, 1) = TT:                         Arr(W, 2) = .Cells(J, "B").Value
                    Arr(W, 3) = .Cells(J, "c").Value:       Arr(W, 4) = .Cells(J, "D").Value
                    Arr(W, 5) = .Cells(J, "E").Value        'Don Giá        '
                    Arr(W, 6) = .Cells(J, Col).Value:       Arr(W, 7) = Arr(W, 5) * Arr(W, 6)
                    Tong = Tong + Arr(W, 6)
                End If
            Next J
        End If
        Set Sh = ThisWorkbook.Worksheets(MaTr)
        Sh.[A9].Resize(W, 8).Value = Arr()
        Erase Arr()
        If Tong > 0 Then
            Cells(Cls.Row, "I").Value = Sh.[G49].Value:     Tong = 0
        End If
    Next Cls
 End With
Err_:           Exit Sub
LoiCT:
    If Err = 9 Then
        Cls.Interior.ColorIndex = 38:
        Tong = 0:                                           Resume Next
    Else
        MsgBox Error:                                       GoTo Err_
    End If
End Sub

quyenpv · 26/9/21

Em xin lỗi chạy và kiểm tra thử các kiểu vẫn không ra được kết quả ạ

SA_DQ · 26/9/21

quyenpv · 26/9/21

SA_DQ đã viết:
:d :d :d :d

Hu hu hu, em không biết nên làm phiền anh nhiều quá ạ
Anh cho em hỏi chút code này chạy có cần các Sheet trạm riêng em đã làm thủ công không anh, vì khi em xóa đi nó báo lỗi này ah

SA_DQ · 26/9/21

Trong file #36 có 4 hay 5 trang đã bị mình xóa trước đây & đã tô màu như hình của bạn; & khi chạy code trên file đó không báo lỗi, do mình đã có động tác khắc phục rồi;
Vậy nên mình chưa biết bạn xóa kiểu gì mà để lỗi làm vậy, chịu!

quyenpv · 26/9/21

SA_DQ đã viết:
Trong file #36 có 4 hay 5 trang đã bị mình xóa trước đây & đã tô màu như hình của bạn; & khi chạy code trên file đó không báo lỗi, do mình đã có động tác khắc phục rồi;
Vậy nên mình chưa biết bạn xóa kiểu gì mà để lỗi làm vậy, chịu!

Dạ vậy là sẽ dùng 2 code tại bài #36 và code Tonghopdulieu luôn hả anh
Với trường hợp code không tách Sheet như trên thì khó quá anh

SA_DQ · 27/9/21

quyenpv đã viết:
(2) . . . . . vậy là sẽ dùng 2 code tại bài #36 và code Tonghopdulieu luôn hả anh
(1) Với trường hợp code không tách Sheet như trên thì khó quá anh

(1) Thì bạn thêm 1 động tác chép trang kết quả thu được về trang đúng tên của nó
Động tác này có thể nhờ ai đó viết thêm 1 hay 1 vài dòng lệnh nữa, bổ sung vô.

(2) Cũng được, tiện cái nào xài cái đó./.

Tách Sheet từ bảng khối lượng tạo phụ lục hợp đồng cho từng trạm

Thu nhặt kiến thức

File đính kèm

Thành viên thường trực

linhvtm84@gmail.com

/(hông là gì!

Thu nhặt kiến thức

/(hông là gì!

Thu nhặt kiến thức

/(hông là gì!

Thu nhặt kiến thức

Thu nhặt kiến thức

/(hông là gì!

File đính kèm

Thu nhặt kiến thức

/(hông là gì!

File đính kèm

Thu nhặt kiến thức

/(hông là gì!

Thu nhặt kiến thức

/(hông là gì!

File đính kèm

Thu nhặt kiến thức

/(hông là gì!

Thu nhặt kiến thức

/(hông là gì!