Xin được giúp đỡ tổng hợp máy thi công theo mã nghiệm thu

Liên hệ QC
Cát Lượng

Cát Lượng

Thành viên tiêu biểu
Tham gia
14/11/18
Bài viết
403
Được thích
66
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!

aa1.png
 

File đính kèm

  • File.xlsx
    51.1 KB · Đọc: 21
Lần chỉnh sửa cuối:
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!
Nhấp chuột vào đây để mở rộng...
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
 
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
Nhấp chuột vào đây để mở rộ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.
b2222.png
 
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ấp chuột vào đây để mở rộng...
Nhấn alt+F11 --> đổi tên sheet trong file bài 1 về sheet1 là được bạn
 
CHAOQUAY đã viết:
Nhấn alt+F11 --> đổi tên sheet trong file bài 1 về sheet1 là được bạn
Nhấp chuột vào đây để mở rộng...
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!vvvv.png
 
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];
Nhấp chuột vào đây để mở rộng...
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!
Nhấp chuột vào đây để mở rộng...
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á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
Nhấp chuột vào đây để mở rộng...
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
 
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
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh HieuCD rất nhiều!
Bài đã được tự động gộp:

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?
Nhấp chuột vào đây để mở rộng...
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
 
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

H
HÀM NỐI CHUỖI CONCAT NHIỀU ĐIỀU KIỆN
Trả lời
2
Đọc
30
Duy Tùng 9x
Duy Tùng 9x
phuyen89
  • Question
Hạn chế số ngày sử dụng của File
2 3
Trả lời
46
Đọc
10K
VetMini
V
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
2
Trả lời
24
Đọc
228
NguyenthiH
NguyenthiH
hongphuong1997
  • Question
Lấy ký tự trong chuỗi theo nhiều điều kiện
Trả lời
14
Đọc
191
hongphuong1997
hongphuong1997
S
Nhờ hỗ trợ code tìm kiếm dữ liệu bằng hộp tìm kiếm
Trả lời
5
Đọc
41
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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

Back
Top Bottom