Lấy đơn giá trong bảng Chiết tính từ file excel xuất ra từ phần mềm dự toán

Liên hệ QC

quyenpv

Thu nhặt kiến thức
Tham gia
5/1/13
Bài viết
719
Được thích
97
Giới tính
Nam
Nghề nghiệp
Decode cuộc đời!
Dear các anh/chị!
Nhờ anh chị hướng dẫn hỗ trợ code giúp em có thể Lấy đơn giá trong bảng Chiết tính từ file excel xuất ra từ phần mềm dự toán. Cụ thể
- Em đã lấy các đầu việc trong Sheet Công trình đưa sang Sheet PLHD được rồi
- Bây giờ em cần lấy đơn giá của công việc đó từ Sheet Chiết tính sang Sheet PLHD (Từ khóa của bảng phân tích công việc đó là Gxd ở cột D). Tuy nhiên số lượng dòng nó không cố định do phụ thuộc vào Vật Liêu, Nhân công, Máy thi công của Công việc đó nên trình độ em ko làm được
- Em có tạo 2 Sheet PLHD_Mong muon là kết quả em đang cần và PLHD_GPE là nơi em đã làm 1 phần nhỏ code
Mong anh chị ghé qua giúp đỡ ạ, em cám ơn
1624596049693.png1624596390155.png
Mã:
Sub Run_PLHD()
    Dim i, k, aGV(), Res()
    Dim LastRow

    With Sheet1
        aGV = .Range("A6:X" & .Range("F" & .Rows.Count).End(xlUp).Row).Value
    End With
    sRow = UBound(aGV)
    ReDim Res(1 To sRow, 1 To 8)

    For i = 1 To sRow
        If aGV(i, 5) <> "" Then
            k = k + 1
            Res(k, 1) = k
            Res(k, 2) = aGV(i, 5)
            Res(k, 3) = aGV(i, 6)
            Res(k, 4) = aGV(i, 7)
            Res(k, 5) = aGV(i, 16)
            Res(k, 6) = 1
            Res(k, 7) = Res(k, 5) * Res(k, 6)
        End If
    Next i
   

    With Sheet57
        If k > 0 Then
        .Range("A5").Resize(k, 8).Value = Res
        End If
    End With

End Sub
 

File đính kèm

  • GPE_Tao PLHD.xls
    552 KB · Đọc: 31
Bạn làm sao đó làm, miễn sao mã công việc trong HM này phân biệt được với mã trong HM kia, dù tên công việc giống nhau.
Còn giờ bạn chép lại code tôi sửa lại cho vấn đề 1 bên trên và clear format vùng trước khi điền kết quả
Rich (BB code):
Sub Run_PLHD_All()

    Dim aGV(), Res()
    Dim Srw&, Erw&, i&, j&, k&, sRow&
    Dim aMS, aDG, arrCT
    Application.ScreenUpdating = False
    With Sheet1
        aGV = .Range("A6:X" & .Range("F" & .Rows.Count).End(xlUp).Row).Value
    End With
    sRow = UBound(aGV)
    ReDim Res(1 To sRow, 1 To 8)

    For i = 1 To sRow
        If aGV(i, 5) <> "" And UCase(Left(aGV(i, 5), 3)) <> "THM" Then
            k = k + 1
            Res(k, 1) = aGV(i, 1)
            Res(k, 2) = aGV(i, 5)
            Res(k, 3) = aGV(i, 6)
            Res(k, 4) = aGV(i, 7)
            Res(k, 5) = aGV(i, 16)
        End If
    Next i
   
    With Sheet57
        .Range("A5:H1000").ClearContents
        .Range("A5:H1000").ClearFormats
        If k > 0 Then
            .Range("A5").Resize(k, 8).Value = Res
        End If
    End With
    k = 0
    Dim Tong#, TongCon#
    aMS = Sheet57.Range("A5:B" & Sheet57.Range("B" & Rows.Count).End(xlUp).Row)
    arrCT = Sheet22.Range("B6:B" & Sheet22.Range("C" & Rows.Count).End(xlUp).Row)
    aDG = Sheet57.Range("E5:G" & Sheet57.Range("B" & Rows.Count).End(xlUp).Row)
    For i = 1 To UBound(aMS)
        k = k + 1
        If aMS(i, 1) <> "" Then
            For j = 1 To UBound(arrCT)
                If arrCT(j, 1) = aMS(i, 2) Then Srw = j + 5: Exit For
            Next
            Erw = Sheet22.Range("A" & Srw).End(xlDown).Row
            aDG(k, 2) = Sheet22.Range("D" & Srw & ":D" & Erw).Find(What:="Gxd", LookIn:=xlFormulas, LookAt:=xlWhole).Offset(, 4).Value
            aDG(k, 3) = aDG(k, 1) * aDG(k, 2)
            Tong = Tong + aDG(k, 3)
        End If
    Next
   
'Tinh toan, dinh dang
For i = UBound(aDG) To 1 Step -1
    If aMS(i, 2) <> "HM" Then
        TongCon = TongCon + aDG(i, 3)
    Else
        aDG(i, 3) = TongCon: TongCon = 0
    End If
Next
With Sheet57
    .Range("E5").Resize(k, 3) = aDG
    'Them dong tong cong:
    i = .Range("C" & 65536).End(xlUp).Row + 1
    .Range("B" & i).Value = "TC"
   
    .Range("C" & i).Value = UCase("Tong cong")
    .Range("B" & i & ":G" & i).Font.Bold = True
    .Range("G" & i) = Tong
    .Range("F5:G" & i).NumberFormat = "#,##0"
    For i = 5 To .Range("C65536").End(xlUp).Row
        If .Range("B" & i) = "HM" Then
            .Range("B" & i & ":G" & i).Font.Bold = True
'            .Range("B" & i & ":G" & i).Font.Italic = True
        End If
    Next
End With

Application.ScreenUpdating = True
MsgBox "Xong!"
End Sub
Dạ cám ơn anh ạ, có gì em sẽ phản hồi nhờ anh giúp đỡ tiếp ạ
 
Upvote 0
Dear anh Maika8008
Hiện Code đang bị lỗi phần cộng TongCon cụ thể em nghĩ đoạn này
Mã:
    'Tinh toan, dinh dang
    For i = UBound(aDG) To 1 Step -1
        If aMS(i, 2) <> "HM" Then
            TongCon = TongCon + aDG(i, 3)
        Else
            aDG(i, 3) = TongCon: TongCon = 0
        End If
    Next

1626078656995.png

Đối với hạng mục cuối cùng hiện Code đang lấy luôn phần TC cộng vào phần HM như trên. Mong anh Fix giúp em đoạn này ạ
Em cám ơn
 
Upvote 0
Dear anh Maika8008
Hiện Code đang bị lỗi phần cộng TongCon cụ thể em nghĩ đoạn này
Mã:
    'Tinh toan, dinh dang
    For i = UBound(aDG) To 1 Step -1
        If aMS(i, 2) <> "HM" Then
            TongCon = TongCon + aDG(i, 3)
        Else
            aDG(i, 3) = TongCon: TongCon = 0
        End If
    Next

View attachment 262291

Đối với hạng mục cuối cùng hiện Code đang lấy luôn phần TC cộng vào phần HM như trên. Mong anh Fix giúp em đoạn này ạ
Em cám ơn
Tôi đang có việc nhà, không thể chú tâm vào việc gì được. Bạn có thể lập chủ đề khác nhờ mọi người vậy.
 
Upvote 0
Các anh chị ơi sửa giúp em với ạ
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn anh nhiều! File chạy trên tuyệt vời ạ, em ko phải sửa mã mỗi khi bị trùng nữa
Một lần nữa cám ơn anh

Dear anh Hoàng Tuấn 868
Có một lỗi phát sinh chỗ này mong anh sửa giúp em với nhé
1. Công tác tại dòng số 11 khối lượng chỉ có 1 nhưng khi sang PLHD lại thành 2
1626348525563.png

1626348666618.png
2. Em muốn để sẵn chân ký bên A, bên B trong Sheet mẫu PLHD thì có cách nào chèn Code chạy dc không anh

1626348738081.png

Em hay dùng đoạn Code này

Mã:
    With sh_PLHD

        LastRow = .Cells(Rows.count, "I").End(xlUp).Row
        If LastRow > 10 Then
            'Xoa toan bo bang du lieu hien huu dang co
            .Rows("10:" & LastRow - 1).Delete Shift:=xlShiftUp
        Else
            .Range("A10:H" & LastRow).ClearContents
        End If
        .Range("A10:A" & 10 + k).EntireRow.Insert

        If k > 0 Then
            .Range("A10").Resize(k, 8).Value = Res
            .Range("C10:C" & 10 + k).WrapText = True
        End If
    End With
 

File đính kèm

  • GPE_Tao PLHD.xls
    720.5 KB · Đọc: 3
Lần chỉnh sửa cuối:
Upvote 0
Có một lỗi phát sinh chỗ này mong anh sửa giúp em với nhé
1. Công tác tại dòng số 11 khối lượng chỉ có 1 nhưng khi sang PLHD lại thành 2
View attachment 262505
2. Em muốn để sẵn chân ký bên A, bên B trong Sheet mẫu PLHD thì có cách nào chèn Code chạy dc không anh
View attachment 262506
Bạn kiểm tra lại.
Không nên dùng tiếng Tây với người Việt: "Dear anh @Hoàng Tuấn 868"
 

File đính kèm

  • GPE_Tao PLHD (2).xls
    719.5 KB · Đọc: 16
Upvote 0
Dạ em rút kinh nghiệm ạ.
Cám ơn anh Code chạy đúng theo ý em rồi ạ.
 
Lần chỉnh sửa cuối:
Upvote 0

Kính gửi anh Hoàng Tuấn 868

Code của anh viết em đã chạy nhiều lần chạy rất tốt, tuy nhiên file hiện tại em không biết lỗi gì chạy không đúng như ý mong muốn, em nhờ anh nếu rảnh anh xem giúp em với nhé
Em cám ơn anh
Bài đã được tự động gộp:

Kính gửi anh Hoàng Tuấn 868

Code của anh viết em đã chạy nhiều lần chạy rất tốt, tuy nhiên file hiện tại em không biết lỗi gì chạy không đúng như ý mong muốn, em nhờ anh nếu rảnh anh xem giúp em với nhé
Em cám ơn anh
Dạ anh em phát hiện ra lỗi rồi, lý do lỗi ở đây mình đang kiểm tra mã công việc và tên công việc giống nhau nên em bổ sung thêm kiểm tra STT nữa thì hết lỗi ạ
Mã:
                For i = 5 To Lr_DT
                    'Ktra Ma hieu CV và Ten Cong viec giong nhau trong Sheet PLHD và Sheet Cong trình
                    'Thi Cot Khoi luong tai Sheet PLHD = Khoi luong tai Sheet Cong trình
                    If .Cells(j, 1) = sh_CTrinh.Cells(i, 1) And .Cells(j, 2) = sh_CTrinh.Cells(i, 5) And .Cells(j, 3) = sh_CTrinh.Cells(i, 6) Then
                        .Cells(j, 5) = sh_CTrinh.Cells(i, 16)
                    End If
                Next
 
Lần chỉnh sửa cuối:
Upvote 0

Kính gửi anh Hoàng Tuấn 868

Code của anh viết em đã chạy nhiều lần chạy rất tốt, tuy nhiên file hiện tại em không biết lỗi gì chạy không đúng như ý mong muốn, em nhờ anh nếu rảnh anh xem giúp em với nhé
Em cám ơn anh
Bài đã được tự động gộp:


Dạ anh em phát hiện ra lỗi rồi, lý do lỗi ở đây mình đang kiểm tra mã công việc và tên công việc giống nhau nên em bổ sung thêm kiểm tra STT nữa thì hết lỗi ạ
Mã:
                For i = 5 To Lr_DT
                    'Ktra Ma hieu CV và Ten Cong viec giong nhau trong Sheet PLHD và Sheet Cong trình
                    'Thi Cot Khoi luong tai Sheet PLHD = Khoi luong tai Sheet Cong trình
                    If .Cells(j, 1) = sh_CTrinh.Cells(i, 1) And .Cells(j, 2) = sh_CTrinh.Cells(i, 5) And .Cells(j, 3) = sh_CTrinh.Cells(i, 6) Then
                        .Cells(j, 5) = sh_CTrinh.Cells(i, 16)
                    End If
                Next
Tôi hoan nghênh cách tiếp cận của bạn. Làm gì phải mày mò thử đi thử lại chứ đâu dễ có code ăn sẵn, ăn ngay.
 
Upvote 0
Tôi hoan nghênh cách tiếp cận của bạn. Làm gì phải mày mò thử đi thử lại chứ đâu dễ có code ăn sẵn, ăn ngay.
Dạ anh, cơ bản không có căn bản nên mày mò và test sau đó hiểu và ghi chú lại anh! Cám ơn các anh đã hỗ trợ nhiệt tình ạ
 
Upvote 0
Bạn kiểm tra lại.
Không nên dùng tiếng Tây với người Việt: "Dear anh @Hoàng Tuấn 868"
Anh Hoàng Tuấn 868, Maika8008 ơi!
Bài này hôm trước anh có giúp em nay phát sinh thêm cần lấy chi phí tư vấn vào phần phụ lục hợp đồng nữa. Anh bớt chút thời gian xem giúp em với nhé
Em cám ơn anh
Mã:
            For p = i + 1 To k
                If .Cells(p, 1) <> "" Then
                    lrd = sh_PLHD.Cells(Rows.Count, 2).End(xlUp).Row + 1
                    q = .Range(Cells(i, 4), Cells(lr1, 4)).Find(what:="Gxd").Row
                    sh_PLHD.Cells(lrd, 1) = .Cells(p, 1)
                    sh_PLHD.Cells(lrd, 2) = .Cells(p, 2)
                    sh_PLHD.Cells(lrd, 3) = .Cells(p, 3)
                    sh_PLHD.Cells(lrd, 4) = .Cells(p, 4)
                    sh_PLHD.Cells(lrd, 6) = .Cells(q, 8)
                    p = q
                    i = q
                End If
            Next p
Chỗ này em thay bằng mã "Gks" nhưng không chạy anh. Em muốn PLHD lấy cả mã Gxd và Gks anh
 

File đính kèm

  • GPE_Tao PLHD (2).xls
    730.5 KB · Đọc: 4
Lần chỉnh sửa cuối:
Upvote 0
Dear các anh/chị!
Nhờ anh chị hướng dẫn hỗ trợ code giúp em có thể Lấy đơn giá trong bảng Chiết tính từ file excel xuất ra từ phần mềm dự toán. Cụ thể
- Em đã lấy các đầu việc trong Sheet Công trình đưa sang Sheet PLHD được rồi
- Bây giờ em cần lấy đơn giá của công việc đó từ Sheet Chiết tính sang Sheet PLHD (Từ khóa của bảng phân tích công việc đó là Gxd ở cột D). Tuy nhiên số lượng dòng nó không cố định do phụ thuộc vào Vật Liêu, Nhân công, Máy thi công của Công việc đó nên trình độ em ko làm được
- Em có tạo 2 Sheet PLHD_Mong muon là kết quả em đang cần và PLHD_GPE là nơi em đã làm 1 phần nhỏ code
Mong anh chị ghé qua giúp đỡ ạ, em cám ơn

Mã:
Sub Run_PLHD()
    Dim i, k, aGV(), Res()
    Dim LastRow

    With Sheet1
        aGV = .Range("A6:X" & .Range("F" & .Rows.Count).End(xlUp).Row).Value
    End With
    sRow = UBound(aGV)
    ReDim Res(1 To sRow, 1 To 8)

    For i = 1 To sRow
        If aGV(i, 5) <> "" Then
            k = k + 1
            Res(k, 1) = k
            Res(k, 2) = aGV(i, 5)
            Res(k, 3) = aGV(i, 6)
            Res(k, 4) = aGV(i, 7)
            Res(k, 5) = aGV(i, 16)
            Res(k, 6) = 1
            Res(k, 7) = Res(k, 5) * Res(k, 6)
        End If
    Next i
  

    With Sheet57
        If k > 0 Then
        .Range("A5").Resize(k, 8).Value = Res
        End If
    End With

End Sub
Chạy code . . .
Mã:
Sub Run_PLHD()
  Dim aCT(), aDG(), Res(), dic As Object
  Dim sRow&, i&, k&, ik&
    
  Set dic = CreateObject("scripting.dictionary")
  With Sheet1 'Sheet Cong trinh
    aCT = .Range("A6:P" & .Range("F" & .Rows.Count).End(xlUp).Row).Value
  End With
  sRow = UBound(aCT)
  ReDim Res(1 To sRow, 1 To 7)
  For i = 1 To sRow
    If aCT(i, 5) = "HM" Then
      k = k + 1
      Res(k, 2) = aCT(i, 5)
      Res(k, 3) = aCT(i, 6)
    End If
    If aCT(i, 1) <> Empty Then
      k = k + 1
      Res(k, 1) = aCT(i, 1)
      Res(k, 2) = aCT(i, 5)
      Res(k, 3) = aCT(i, 6)
      Res(k, 4) = aCT(i, 7)
      Res(k, 5) = aCT(i, 16)
      dic(Res(k, 2)) = k
    End If
  Next
  With Sheet22 'Sheet Chiet tinh
    aDG = .Range("A5", .Range("H" & .Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(aDG)
  For i = 1 To sRow
    If aDG(i, 1) <> Empty Then ik = 0
    If dic.exists(aDG(i, 2)) Then ik = dic(aDG(i, 2))
    If aDG(i, 4) = "Gxd" Then
      If ik > 0 Then
        Res(ik, 6) = aDG(i, 8)
        If Res(ik, 5) <> Empty Then Res(ik, 7) = Res(ik, 5) * Res(ik, 6)
      End If
    End If
  Next i

  With Sheet57 'Sheet PLHD_GPE
    i = .Range("A" & .Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("A5:H" & i).ClearContents
    If k > 0 Then
      .Range("A5").Resize(k, 7).Value = Res
    End If
  End With
End Sub
Lưu ý: Tên Sheet không nên dùng tiếng Việt có dấu
 
Upvote 0
Chạy code . . .
Mã:
Sub Run_PLHD()
  Dim aCT(), aDG(), Res(), dic As Object
  Dim sRow&, i&, k&, ik&
 
  Set dic = CreateObject("scripting.dictionary")
  With Sheet1 'Sheet Cong trinh
    aCT = .Range("A6:P" & .Range("F" & .Rows.Count).End(xlUp).Row).Value
  End With
  sRow = UBound(aCT)
  ReDim Res(1 To sRow, 1 To 7)
  For i = 1 To sRow
    If aCT(i, 5) = "HM" Then
      k = k + 1
      Res(k, 2) = aCT(i, 5)
      Res(k, 3) = aCT(i, 6)
    End If
    If aCT(i, 1) <> Empty Then
      k = k + 1
      Res(k, 1) = aCT(i, 1)
      Res(k, 2) = aCT(i, 5)
      Res(k, 3) = aCT(i, 6)
      Res(k, 4) = aCT(i, 7)
      Res(k, 5) = aCT(i, 16)
      dic(Res(k, 2)) = k
    End If
  Next
  With Sheet22 'Sheet Chiet tinh
    aDG = .Range("A5", .Range("H" & .Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(aDG)
  For i = 1 To sRow
    If aDG(i, 1) <> Empty Then ik = 0
    If dic.exists(aDG(i, 2)) Then ik = dic(aDG(i, 2))
    If aDG(i, 4) = "Gxd" Then
      If ik > 0 Then
        Res(ik, 6) = aDG(i, 8)
        If Res(ik, 5) <> Empty Then Res(ik, 7) = Res(ik, 5) * Res(ik, 6)
      End If
    End If
  Next i

  With Sheet57 'Sheet PLHD_GPE
    i = .Range("A" & .Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("A5:H" & i).ClearContents
    If k > 0 Then
      .Range("A5").Resize(k, 7).Value = Res
    End If
  End With
End Sub
Lưu ý: Tên Sheet không nên dùng tiếng Việt có dấu
Dạ em cám ơn anh nhiều lắm luôn ạ!
Do phần mềm G8 xuất ra file excel có sẵn các Sheet đặt tên có dấu tiếng Việt anh ạ

Nhờ anh bổ sung thêm giúp em phần tổng cộng và đọc số ra chữ ở phía dưới với ạ

1651102582870.png
 
Upvote 0
Dạ anh @HieuCD ơi, nhờ anh hỗ trợ em thêm với ạ
1. Code hiện đang lỗi không lấy được giá trị đối với trường hợp trùng mã (Điều này dự toán luôn luôn có)
2. Thêm dòng tổng hạng mục cuối cùng và đọc số thành chữ.
3. Nếu có thể anh tách riêng phần tư vấn sang 1 Sheet "PLHD_TVTK". Sheet "PLHD_GPE" chỉ lấy phần Gxd ạ
Em cám ơn anh rất nhiều ạ
 

File đính kèm

  • GPE_Tao PLHD.xls
    634.5 KB · Đọc: 5
Upvote 0
Dạ anh @HieuCD ơi, nhờ anh hỗ trợ em thêm với ạ
1. Code hiện đang lỗi không lấy được giá trị đối với trường hợp trùng mã (Điều này dự toán luôn luôn có)
2. Thêm dòng tổng hạng mục cuối cùng và đọc số thành chữ.
3. Nếu có thể anh tách riêng phần tư vấn sang 1 Sheet "PLHD_TVTK". Sheet "PLHD_GPE" chỉ lấy phần Gxd ạ
Em cám ơn anh rất nhiều ạ
Không có add in đọc số, tự thêm vào
Không rỏ làm cách nào phân biệt phần tư vấn
Chạy code tạm
Mã:
Sub Run_PLHD()
  Dim aCT(), aDG(), Res(), dic As Object
  Dim sRow&, i&, k&, ik&, tong#, key$
    
  Set dic = CreateObject("scripting.dictionary")
  With Sheet1 'Sheet Cong trinh
    aCT = .Range("A6:P" & .Range("F" & .Rows.Count).End(xlUp).Row).Value
  End With
  sRow = UBound(aCT)
  ReDim Res(1 To sRow, 1 To 7)
  For i = 1 To sRow
    If aCT(i, 5) = "HM" Then
      k = k + 1
      Res(k, 2) = aCT(i, 5)
      Res(k, 3) = aCT(i, 6)
    End If
    If aCT(i, 1) <> Empty Then
      k = k + 1
      Res(k, 1) = aCT(i, 1)
      Res(k, 2) = aCT(i, 5)
      Res(k, 3) = aCT(i, 6)
      Res(k, 4) = aCT(i, 7)
      Res(k, 5) = aCT(i, 16)
      dic(Res(k, 1) & "|" & Res(k, 2)) = k
    End If
  Next
  With Sheet22 'Sheet Chiet tinh
    aDG = .Range("A5", .Range("H" & .Rows.Count).End(xlUp)).Value
  End With
  sRow = UBound(aDG)
  For i = 1 To sRow
    If aDG(i, 1) <> Empty Then ik = 0
    key = aDG(i, 1) & "|" & aDG(i, 2)
    If dic.exists(key) Then ik = dic(key)
    If aDG(i, 4) = "Gxd" Or aDG(i, 4) = "Gks" Then
      If ik > 0 Then
        Res(ik, 6) = aDG(i, 8)
        If Res(ik, 5) <> Empty Then
          Res(ik, 7) = Res(ik, 5) * Res(ik, 6)
          tong = tong + Res(ik, 7)
        End If
      End If
    End If
  Next i

  With Sheet57 'Sheet PLHD_GPE
    i = .Range("A" & .Rows.Count).End(xlUp).Row
    If i > 4 Then .Range("A5:H" & i).ClearContents
    If k > 0 Then
      .Range("A5").Resize(k, 7).Value = Res
      .Range("C5").Offset(k) = "T" & ChrW(7892) & "NG H" & ChrW(7840) & "NG M" & ChrW(7908) & "C"
      .Range("G5").Offset(k) = tong
      .Range("C5").Offset(k + 1) = "Doc so tien" 'Tu lo nhé
    End If
  End With
End Sub
 
Upvote 0
Em cám ơn anh nhiều ạ
 
Upvote 0
Web KT

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

Back
Top Bottom