lập bảng tổng hợp vật tư từ phân tích vật tư bằng vba

[vanmanhcdcd4]

các chuyên gia giúp em với, e cần lập bảng tổng hợp vật tư tự động từ bảng phân tích vật tư có sẵn ạ. e cảm ơn!

 

[keyeutien]

các chuyên gia giúp em với, e cần lập bảng tổng hợp vật tư tự động từ bảng phân tích vật tư có sẵn ạ. e cảm ơn!

Bạn nên tạo luôn sheet tổng hợp, điền những phần nào có thể làm, còn phần chưa làm được thì mọi người có thể giúp công thức hoặc code..Chứ đưa dữ liệu thô rồi nhờ từ a-z thì cũng ít người giúp lắm

 

[SA_DQ]

các chuyên gia giúp em với, e cần lập bảng tổng hợp vật tư tự động từ bảng phân tích vật tư có sẵn ạ. e c. . .

Đầu câu sao không viết 'bông'?
Vậy biểu mẫu 'bảng tổng hợp VT' tự động đâu? Bạn có thể chưng ra cho mọi người trên cộng đồng chiêm nghiệm được không?

(+) Tên trang tính không nên là tiếng Việt có dấu
(+) Bạn hình như cũng chưa đưa lên bảng phân tích VT hay sao í nhỉ? (Trong file chỉ có bảng đơn giá xây dựng chi tiết thôi, phải không?

 

[PacificPR]

các chuyên gia giúp em với, e cần lập bảng tổng hợp vật tư tự động từ bảng phân tích vật tư có sẵn ạ. e cảm ơn!

Mình tìm được cái này. Bạn tham khảo thử

 

[vanmanhcdcd4]

Mình tìm được cái này. Bạn tham khảo thử

mình cảm ơn bạn nhé

 

[quyenpv]

Cũng đang mò mẫm về DIC nhưng thực sự không hiểu nắm. Các anh chị thông thái giải thích giúp từng câu lệnh để anh em vỡ ra để không phải lập nhiều Topic được không ạ
Cám ơn anh chị nhiều

Sub TongHopVT()
Application.ScreenUpdating = False
    Dim Dic As Object, sArr(), dArr(), tArr(), sKey As String, eRw As Long
    Dim I As Long, N As Long, K As Long, LaMa As Long, Stt As Long, R As Long
    Dim VL As String, NC As String, MTC As String, MaTK As String
VL = "V" & ChrW$(7853) & "t li" & ChrW$(7879) & "u"
NC = "Nh" & ChrW$(226) & "n c" & ChrW$(244) & "ng"
MTC = "M" & ChrW$(225) & "y Thi c" & ChrW$(244) & "ng"
tArr = Array(VL, NC, MTC)
Set Dic = CreateObject("scripting.Dictionary")
With Sheet11
    eRw = .Range("C" & Rows.Count).End(xlUp).Row
    sArr = .Range("B5:B" & eRw).Resize(, 7).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 5)
With Sheets("Tonghop")
    With .Range("A3:E10000")
        .ClearContents:        .Interior.ColorIndex = 0:        .Borders.LineStyle = 0:        .Font.Bold = False
    End With
    For N = 0 To 2
        Stt = 0:        LaMa = LaMa + 1:        K = K + 1
        dArr(K, 1) = ChrW(LaMa + 64):        dArr(K, 2) = tArr(N)
        .Range("A" & K + 2).Resize(, 5).Interior.ColorIndex = 8
        .Range("A" & K + 2).Resize(, 5).Font.Bold = True
        For I = 1 To UBound(sArr, 1)
            MaTK = IIf(N = 0, "A", Left(tArr(N), 1))
            If Left(sArr(I, 1), 1) = MaTK And sArr(I, 5) <> Empty Then
                sKey = sArr(I, 1)
                If Not Dic.Exists(sKey) Then
                    K = K + 1: Stt = Stt + 1
                    Dic.Add sKey, K
                    dArr(K, 1) = Stt:   dArr(K, 2) = sArr(I, 1)
                    dArr(K, 3) = sArr(I, 2):  dArr(K, 4) = sArr(I, 3)
                    dArr(K, 5) = sArr(I, 4)
                Else
                    R = Dic.Item(sKey)
                    dArr(R, 5) = dArr(R, 5) + sArr(I, 4)
                End If
            End If
        Next I
    Next N
    .Range("A3").Resize(K, 5) = dArr
    .Range("A3").Resize(K, 5).Borders.LineStyle = 1
    eRw = .Range("A65536").End(xlUp).Row
    For I = eRw To 3 Step -1
        If Not IsNumeric(.Range("A" & I)) Then
            .Range("B" & I + 1 & ":E" & eRw).Sort Key1:=.Range("C" & I + 1)
            eRw = I - 1
        End If
    Next I
End With
Set Dic = Nothing
End Sub

 

[PacificPR]

Cũng đang mò mẫm về DIC nhưng thực sự không hiểu nắm. Các anh chị thông thái giải thích giúp từng câu lệnh để anh em vỡ ra để không phải lập nhiều Topic được không ạ
Cám ơn anh chị nhiều

Sub TongHopVT()
Application.ScreenUpdating = False
    Dim Dic As Object, sArr(), dArr(), tArr(), sKey As String, eRw As Long
    Dim I As Long, N As Long, K As Long, LaMa As Long, Stt As Long, R As Long
    Dim VL As String, NC As String, MTC As String, MaTK As String
VL = "V" & ChrW$(7853) & "t li" & ChrW$(7879) & "u"
NC = "Nh" & ChrW$(226) & "n c" & ChrW$(244) & "ng"
MTC = "M" & ChrW$(225) & "y Thi c" & ChrW$(244) & "ng"
tArr = Array(VL, NC, MTC)
Set Dic = CreateObject("scripting.Dictionary")
With Sheet11
    eRw = .Range("C" & Rows.Count).End(xlUp).Row
    sArr = .Range("B5:B" & eRw).Resize(, 7).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 5)
With Sheets("Tonghop")
    With .Range("A3:E10000")
        .ClearContents:        .Interior.ColorIndex = 0:        .Borders.LineStyle = 0:        .Font.Bold = False
    End With
    For N = 0 To 2
        Stt = 0:        LaMa = LaMa + 1:        K = K + 1
        dArr(K, 1) = ChrW(LaMa + 64):        dArr(K, 2) = tArr(N)
        .Range("A" & K + 2).Resize(, 5).Interior.ColorIndex = 8
        .Range("A" & K + 2).Resize(, 5).Font.Bold = True
        For I = 1 To UBound(sArr, 1)
            MaTK = IIf(N = 0, "A", Left(tArr(N), 1))
            If Left(sArr(I, 1), 1) = MaTK And sArr(I, 5) <> Empty Then
                sKey = sArr(I, 1)
                If Not Dic.Exists(sKey) Then
                    K = K + 1: Stt = Stt + 1
                    Dic.Add sKey, K
                    dArr(K, 1) = Stt:   dArr(K, 2) = sArr(I, 1)
                    dArr(K, 3) = sArr(I, 2):  dArr(K, 4) = sArr(I, 3)
                    dArr(K, 5) = sArr(I, 4)
                Else
                    R = Dic.Item(sKey)
                    dArr(R, 5) = dArr(R, 5) + sArr(I, 4)
                End If
            End If
        Next I
    Next N
    .Range("A3").Resize(K, 5) = dArr
    .Range("A3").Resize(K, 5).Borders.LineStyle = 1
    eRw = .Range("A65536").End(xlUp).Row
    For I = eRw To 3 Step -1
        If Not IsNumeric(.Range("A" & I)) Then
            .Range("B" & I + 1 & ":E" & eRw).Sort Key1:=.Range("C" & I + 1)
            eRw = I - 1
        End If
    Next I
End With
Set Dic = Nothing
End Sub

Ơ. Bạn muốn tìm hiểu thì GPE có 2 bài viết rất chi tiết và mấy nghìn bài ví dụ đó . Còn dịch từng code lệnh thì GPE thấy hơi ít. Rảnh mình cũng hay lang thang thấy có cái trang nhí nhố có dịch từng dòng lệnh VBA ra tiếng Việt...