Xin được giúp đỡ tổng hợp máy thi công theo mã nghiệm thu (2 người xem)

Cát Lượng · 19/5/20

Xin chào các anh/chị trên điễn đàn.
Nhờ các anh/chị giúp em đoạn code để sau khi chạy code có thể tổng hợp được máy thi công tương ứng với mã công việc nghiệm thu trong cột D theo quy luật.
Em xin minh họa cụ thể dữ liệu bằng số liệu cho trực quan:
Máy cần tổng hợp được điền vào Z9 và Z13
Máy sau khi được điền vào ô Z9 = Máy trong ô Z9 ( ban đầu chưa tổng hợp) + Z10 + Z11 + Z12
Máy sau khi được điền vào ô Z13 = Máy trong ô Z13 ( ban đầu chưa tổng hợp) + Z14 + Z15
Ban đầu dữ liệu như hình (em có đính kèm file).
Sau khi tổng hợp máy móc thi công thì dữ liệu được điền vào:
1/ ô Z9 là :
Máy cắt uốn cắt thép 5Kw [1];Vận thăng lồng 3T [2];Cẩu tháp 25 tấn [1];Máy hàn điện 23Kw [1];
2/ ô Z13 là :
Máy trộn bê tông 250l [1];Đầm dùi 1,5Kw [1];Máy vận thăng 0,8T [];Dụng cụ lấy mẫu [2];'Máy bơm nước [1];

Mong được sự giúp đỡ từ phía các anh/chị
Em xin cảm ơn!

CHAOQUAY · 19/5/20

Cát Lượng đã viết:
Xin chào các anh/chị trên điễn đàn.
Nhờ các anh/chị giúp em đoạn code để sau khi chạy code có thể tổng hợp được máy thi công tương ứng với mã công việc nghiệm thu trong cột D theo quy luật.
Em xin minh họa cụ thể dữ liệu bằng số liệu cho trực quan:
Máy cần tổng hợp được điền vào Z9 và Z13
Máy sau khi được điền vào ô Z9 = Máy trong ô Z9 ( ban đầu chưa tổng hợp) + Z10 + Z11 + Z12
Máy sau khi được điền vào ô Z13 = Máy trong ô Z13 ( ban đầu chưa tổng hợp) + Z14 + Z15
Ban đầu dữ liệu như hình (em có đính kèm file).
Sau khi tổng hợp máy móc thi công thì dữ liệu được điền vào:
1/ ô Z9 là :
Máy cắt uốn cắt thép 5Kw [1];Vận thăng lồng 3T [2];Cẩu tháp 25 tấn [1];Máy hàn điện 23Kw [1];
2/ ô Z13 là :
Máy trộn bê tông 250l [1];Đầm dùi 1,5Kw [1];Máy vận thăng 0,8T [];Dụng cụ lấy mẫu [2];'Máy bơm nước [1];

Mong được sự giúp đỡ từ phía các anh/chị
Em xin cảm ơn!

Chạy thử code dưới đây. Kết quả tạm điền vào cột "BO"

Mã:

Option Explicit

Sub TH_MTC()
Dim rws As Long
Dim mDic As Object
Dim reg As Object
Dim i, j, k, x, z, t
Set mDic = CreateObject("Scripting.Dictionary")
Set reg = CreateObject("VbScript.RegExp")
reg.Global = True
reg.Pattern = "([^;\]\[]+)\[(\d+)\]"
With Sheet1
    rws = .Range("G1000000").End(xlUp).Row
    i = 9
    Do While i < rws
        mDic.RemoveAll
        For j = i To rws
            If .Range("A" & j) <= .Range("A" & i) Then
                If reg.test(.Range("Z" & j)) Then
                    z = 0
                    For Each k In reg.Execute(.Range("Z" & j))
                        mDic(Trim(k.submatches(0))) = mDic(Trim(k.submatches(0))) + CLng(k.submatches(1))
                    Next k
                End If
            Else
                Exit For
            End If
        Next j
        For Each k In mDic.keys
            .Range("BO" & i) = .Range("BO" & i) & ";" & k & " " & "[" & mDic(k) & "]"
        Next k
        .Range("BO" & i) = Right(.Range("BO" & i), Len(.Range("BO" & i)) - 1)
        i = j
    Loop
End With
End Sub

---
Nếu kết quả điền trực tiếp vào Z9, Z13 có lẽ giải trình số lượng máy hơi bị mệt vì số liệu riêng tại Z9, Z13 bị lẫn vào số lượng tổng

Cát Lượng · 19/5/20

CHAOQUAY đã viết:

Chạy thử code dưới đây. Kết quả tạm điền vào cột "BO"

Mã:

Option Explicit

Sub TH_MTC()
Dim rws As Long
Dim mDic As Object
Dim reg As Object
Dim i, j, k, x, z, t
Set mDic = CreateObject("Scripting.Dictionary")
Set reg = CreateObject("VbScript.RegExp")
reg.Global = True
reg.Pattern = "([^;\]\[]+)\[(\d+)\]"
With Sheet1
    rws = .Range("G1000000").End(xlUp).Row
    i = 9
    Do While i < rws
        mDic.RemoveAll
        For j = i To rws
            If .Range("A" & j) <= .Range("A" & i) Then
                If reg.test(.Range("Z" & j)) Then
                    z = 0
                    For Each k In reg.Execute(.Range("Z" & j))
                        mDic(Trim(k.submatches(0))) = mDic(Trim(k.submatches(0))) + CLng(k.submatches(1))
                    Next k
                End If
            Else
                Exit For
            End If
        Next j
        For Each k In mDic.keys
            .Range("BO" & i) = .Range("BO" & i) & ";" & k & " " & "[" & mDic(k) & "]"
        Next k
        .Range("BO" & i) = Right(.Range("BO" & i), Len(.Range("BO" & i)) - 1)
        i = j
    Loop
End With
End Sub

---
Nếu kết quả điền trực tiếp vào Z9, Z13 có lẽ giải trình số lượng máy hơi bị mệt vì số liệu riêng tại Z9, Z13 bị lẫn vào số lượng tổng

Em xin cảm ơn, Nếu kết quả có thể điền trực tiếp luôn vào ô Z9, Z13 luôn thì tốt quá. vì dữ liệu em cần lấy luôn tại ô đó để có thể xuất sang nhật ký ạ!
Em chạy thấy báo lỗi? mong anh/chị giúp em.

PacificPR · 19/5/20

Cát Lượng đã viết:
Em xin cảm ơn, Nếu kết quả có thể điền trực tiếp luôn vào ô Z9, Z13 luôn thì tốt quá. vì dữ liệu em cần lấy luôn tại ô đó để có thể xuất sang nhật ký ạ!
Em chạy thấy báo lỗi? mong anh/chị giúp em.
View attachment 237629

Bạn xem File nhà mình có còn Sheet1 không hay nó chạy đi chơi mất rồi

CHAOQUAY · 19/5/20

Cát Lượng đã viết:
Em xin cảm ơn, Nếu kết quả có thể điền trực tiếp luôn vào ô Z9, Z13 luôn thì tốt quá. vì dữ liệu em cần lấy luôn tại ô đó để có thể xuất sang nhật ký ạ!
Em chạy thấy báo lỗi? mong anh/chị giúp em.

Nhấn alt+F11 --> đổi tên sheet trong file bài 1 về sheet1 là được bạn

Cát Lượng · 19/5/20

CHAOQUAY đã viết:
Nhấn alt+F11 --> đổi tên sheet trong file bài 1 về sheet1 là được bạn

Dạ! em đã sửa lại và chạy code, nhưng chưa có kết quả mong muốn:
Sau khi chạy code lần đầu Số lượng máy bị cộng dồn lại (em chỉ muốn lấy số lượng máy max, chứ không cộng dồn lại) và sau khi chạy code lần thứ 2 máy tiếp tục bị cộng dồn (ý em là chỉ chạy code lần 1 thôi, nếu vô tình nhấn code lần 2 thì code kết quả chạy code lần 1 vẫn được giữ nguyên)
Em xin cảm ơn nhiều!

CHAOQUAY · 19/5/20

@Cát Lượng
code theo đầu bài thôi bạn.,

Cát Lượng · 20/5/20

CHAOQUAY đã viết:
@Cát Lượng
code theo đầu bài thôi bạn.,

Dạ em cam ơn, nhưng chạy code chưa ra kết quả như đầu bài ạ!

CHAOQUAY · 20/5/20

Cát Lượng đã viết:
...
Máy cần tổng hợp được điền vào Z9 và Z13
Máy sau khi được điền vào ô Z9 = Máy trong ô Z9 ( ban đầu chưa tổng hợp) + Z10 + Z11 + Z12
Máy sau khi được điền vào ô Z13 = Máy trong ô Z13 ( ban đầu chưa tổng hợp) + Z14 + Z15
Ban đầu dữ liệu như hình (em có đính kèm file).
Sau khi tổng hợp máy móc thi công thì dữ liệu được điền vào:
1/ ô Z9 là :
Máy cắt uốn cắt thép 5Kw [1];Vận thăng lồng 3T [2];Cẩu tháp 25 tấn [1];Máy hàn điện 23Kw [1];
2/ ô Z13 là :
Máy trộn bê tông 250l [1];Đầm dùi 1,5Kw [1];Máy vận thăng 0,8T [];Dụng cụ lấy mẫu [2];'Máy bơm nước [1];

Cát Lượng đã viết:
Dạ! em đã sửa lại và chạy code, nhưng chưa có kết quả mong muốn:
Sau khi chạy code lần đầu Số lượng máy bị cộng dồn lại (em chỉ muốn lấy số lượng máy max, chứ không cộng dồn lại) và sau khi chạy code lần thứ 2 máy tiếp tục bị cộng dồn (ý em là chỉ chạy code lần 1 thôi, nếu vô tình nhấn code lần 2 thì code kết quả chạy code lần 1 vẫn được giữ nguyên)
Em xin cảm ơn nhiều!

Cái màu xanh bên trên và màu xanh bên dưới ghép lại với nhau thì kết lại là thế nào?

Như bài 1 của bạn, trường hợp Z9 hoặc Z13 có số liệu trước khi chạy code lần đầu tiên, điều kiện nào xác định là đã tổng hợp hay chưa?

HieuCD · 20/5/20

Cát Lượng đã viết:
Xin chào các anh/chị trên điễn đàn.
Nhờ các anh/chị giúp em đoạn code để sau khi chạy code có thể tổng hợp được máy thi công tương ứng với mã công việc nghiệm thu trong cột D theo quy luật.
Em xin minh họa cụ thể dữ liệu bằng số liệu cho trực quan:
Máy cần tổng hợp được điền vào Z9 và Z13
Máy sau khi được điền vào ô Z9 = Máy trong ô Z9 ( ban đầu chưa tổng hợp) + Z10 + Z11 + Z12
Máy sau khi được điền vào ô Z13 = Máy trong ô Z13 ( ban đầu chưa tổng hợp) + Z14 + Z15
Ban đầu dữ liệu như hình (em có đính kèm file).
Sau khi tổng hợp máy móc thi công thì dữ liệu được điền vào:
1/ ô Z9 là :
Máy cắt uốn cắt thép 5Kw [1];Vận thăng lồng 3T [2];Cẩu tháp 25 tấn [1];Máy hàn điện 23Kw [1];
2/ ô Z13 là :
Máy trộn bê tông 250l [1];Đầm dùi 1,5Kw [1];Máy vận thăng 0,8T [];Dụng cụ lấy mẫu [2];'Máy bơm nước [1];

Mong được sự giúp đỡ từ phía các anh/chị
Em xin cảm ơn!

View attachment 237615

Thử code

Mã:

Sub XYZ()
  Dim sArr(), Res(), Dic As Object, S, S2
  Dim sRow&, i&, j&, iK&, tmp&, iKey
 
  Set Dic = CreateObject("scripting.dictionary")
  Dic.CompareMode = vbTextCompare
  With Sheets("Danh muc NT cong viec")
    i = .Range("G1000000").End(xlUp).Row
    sArr = .Range("E9:E" & i + 1).Value
    Res = .Range("Z9:Z" & i).Value
    sRow = UBound(sArr) - 1
    For i = 1 To sRow
      If sArr(i, 1) = Empty Then iK = i
      If Res(i, 1) <> Empty Then
        S = Split(Res(i, 1), ";")
        For j = 0 To UBound(S)
          If InStr(1, S(j), "[") Then
            S2 = Split(Replace(S(j), "]", ""), "[")
            iKey = Application.Trim(S2(0))
            tmp = CLng(S2(1))
            If Dic.exists(iKey) = False Then
              Dic.Add (iKey), tmp
            Else
              If tmp > Dic.Item(iKey) Then Dic.Item(iKey) = tmp
            End If
          End If
        Next j
      End If
      If sArr(i + 1, 1) = Empty Then
        If Dic.Count > 0 Then
          For Each iKey In Dic.keys
            Dic.Item(iKey) = iKey & " [" & Dic.Item(iKey) & "]"
          Next iKey
          Res(iK, 1) = Join(Dic.items, ";")
        End If
        Dic.RemoveAll
      End If
    Next i
    .Range("Z9").Resize(sRow) = Res
  End With
End Sub

Cát Lượng · 20/5/20

HieuCD đã viết:

Thử code

Mã:

Sub XYZ()
  Dim sArr(), Res(), Dic As Object, S, S2
  Dim sRow&, i&, j&, iK&, tmp&, iKey

  Set Dic = CreateObject("scripting.dictionary")
  Dic.CompareMode = vbTextCompare
  With Sheets("Danh muc NT cong viec")
    i = .Range("G1000000").End(xlUp).Row
    sArr = .Range("E9:E" & i + 1).Value
    Res = .Range("Z9:Z" & i).Value
    sRow = UBound(sArr) - 1
    For i = 1 To sRow
      If sArr(i, 1) = Empty Then iK = i
      If Res(i, 1) <> Empty Then
        S = Split(Res(i, 1), ";")
        For j = 0 To UBound(S)
          If InStr(1, S(j), "[") Then
            S2 = Split(Replace(S(j), "]", ""), "[")
            iKey = Application.Trim(S2(0))
            tmp = CLng(S2(1))
            If Dic.exists(iKey) = False Then
              Dic.Add (iKey), tmp
            Else
              If tmp > Dic.Item(iKey) Then Dic.Item(iKey) = tmp
            End If
          End If
        Next j
      End If
      If sArr(i + 1, 1) = Empty Then
        If Dic.Count > 0 Then
          For Each iKey In Dic.keys
            Dic.Item(iKey) = iKey & " [" & Dic.Item(iKey) & "]"
          Next iKey
          Res(iK, 1) = Join(Dic.items, ";")
        End If
        Dic.RemoveAll
      End If
    Next i
    .Range("Z9").Resize(sRow) = Res
  End With
End Sub

Em cảm ơn anh HieuCD rất nhiều!

Bài đã được tự động gộp: 20/5/20

CHAOQUAY đã viết:
Cái màu xanh bên trên và màu xanh bên dưới ghép lại với nhau thì kết lại là thế nào?

Như bài 1 của bạn, trường hợp Z9 hoặc Z13 có số liệu trước khi chạy code lần đầu tiên, điều kiện nào xác định là đã tổng hợp hay chưa?

Cái Z9, Z13 là dữ liệu sau khi chạy code :
Z9 = Máy trong ô Z9 ( ban đầu chưa chạy code) + Z10 + Z11 + Z12
Z13 = Máy trong ô Z13 ( ban đầu chưa chạy code) + Z14 + Z15

Xin được giúp đỡ tổng hợp máy thi công theo mã nghiệm thu (2 người xem)

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

Cát Lượng

Thành viên tiêu biểu

File đính kèm

CHAOQUAY

Thành viên gắn bó

Cát Lượng

Thành viên tiêu biểu

PacificPR

Thành viên mới

CHAOQUAY

Thành viên gắn bó

Cát Lượng

Thành viên tiêu biểu

CHAOQUAY

Thành viên gắn bó

Cát Lượng

Thành viên tiêu biểu

CHAOQUAY

Thành viên gắn bó

HieuCD

Chuyên gia GPE

Cát Lượng

Thành viên tiêu biểu

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

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