Nhờ vả Vấn đề tổng hợp dữ liệu nhiều sheet lên 1 theo điều kiện

Liên hệ QC

vncws99

Thành viên mới
Tham gia
10/8/15
Bài viết
13
Được thích
0
Hi các anh/chị GPE,

Em biết vấn đề này phổ biến và chắc cũng nhiều người hỏi rôi, nhưng em tìm và cũng đã thử các thread tương tự nhưng chưa dc kết quả ưng ý nhất :( (hoặc e tìm không thấy)
Vấn đề của em như sau:
Em có 1 file master với tên mỗi sheet là tên viết tắt của công ty
Giờ e muốn tổng hợp dữ liệu từng file tương ứng với tên công theo cột đã định sẵn tên công ty như trong sheet master, từng chỉ tiêu tương ứng với sheet master.
Hiện tại em đang dùng hàm vlookup nhưng nó vẫn thủ công :( .
Cảm ơn các anh/chị nhiều
-- ---------------------------------------------------
 

File đính kèm

  • Help ..xlsx
    43.4 KB · Đọc: 27
Lỡ rồi :( mình tìm ko thấy chỗ sửa tiêu đề.
Bạn thử code này xem.
Mã:
Sub tonghop()
    Dim sh As Worksheet, i As Long, j As Long, data, arr, dic As Object, lr As Long, a As Long, b As Long, ten As String, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("master")
         .Range("C7:K227").ClearContents
         data = .Range("A5:K227").Value
         For i = 3 To UBound(data)
             dic.Item(data(i, 2)) = i
         Next i
         For i = 4 To UBound(data, 2)
             dk = UCase(data(1, i) & "#" & data(2, i))
             dic.Item(dk) = i
         Next i
    End With
    For Each sh In ThisWorkbook.Worksheets
         If sh.Name <> "Master" Then
            ten = sh.Name
            arr = sh.Range("A6:E227").Value
                For i = 2 To UBound(arr)
                    a = dic.Item(arr(i, 2))
                    If a Then
                       For j = 4 To UBound(arr, 2)
                           dk = UCase(ten & "#" & arr(1, j))
                           b = dic.Item(dk)
                           If b Then
                              If arr(i, j) <> Empty Then
                               If b = 3 Then
                                  data(a, b) = arr(i, j) & " " & data(a, b)
                               Else
                                  data(a, b) = arr(i, j) + data(a, b)
                               End If
                             End If
                           End If
                       Next j
                  End If
             Next i
       End If
   Next
   With Sheets("master")
     .Range("A5:K227").Value = data
   End With
End Sub
 
Upvote 0
Bạn thử code này xem.
Mã:
Sub tonghop()
    Dim sh As Worksheet, i As Long, j As Long, data, arr, dic As Object, lr As Long, a As Long, b As Long, ten As String, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("master")
         .Range("C7:K227").ClearContents
         data = .Range("A5:K227").Value
         For i = 3 To UBound(data)
             dic.Item(data(i, 2)) = i
         Next i
         For i = 4 To UBound(data, 2)
             dk = UCase(data(1, i) & "#" & data(2, i))
             dic.Item(dk) = i
         Next i
    End With
    For Each sh In ThisWorkbook.Worksheets
         If sh.Name <> "Master" Then
            ten = sh.Name
            arr = sh.Range("A6:E227").Value
                For i = 2 To UBound(arr)
                    a = dic.Item(arr(i, 2))
                    If a Then
                       For j = 4 To UBound(arr, 2)
                           dk = UCase(ten & "#" & arr(1, j))
                           b = dic.Item(dk)
                           If b Then
                              If arr(i, j) <> Empty Then
                               If b = 3 Then
                                  data(a, b) = arr(i, j) & " " & data(a, b)
                               Else
                                  data(a, b) = arr(i, j) + data(a, b)
                               End If
                             End If
                           End If
                       Next j
                  End If
             Next i
       End If
   Next
   With Sheets("master")
     .Range("A5:K227").Value = data
   End With
End Sub
Cảm ơn bạn nhiều, mình chạy thấy đúng rồi , để mình xem code học hỏi :p
sao bạn code nhanh vậy :eek:
 
Upvote 0
Bạn thử code này xem.
Mã:
Sub tonghop()
    Dim sh As Worksheet, i As Long, j As Long, data, arr, dic As Object, lr As Long, a As Long, b As Long, ten As String, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("master")
         .Range("C7:K227").ClearContents
         data = .Range("A5:K227").Value
         For i = 3 To UBound(data)
             dic.Item(data(i, 2)) = i
         Next i
         For i = 4 To UBound(data, 2)
             dk = UCase(data(1, i) & "#" & data(2, i))
             dic.Item(dk) = i
         Next i
    End With
    For Each sh In ThisWorkbook.Worksheets
         If sh.Name <> "Master" Then
            ten = sh.Name
            arr = sh.Range("A6:E227").Value
                For i = 2 To UBound(arr)
                    a = dic.Item(arr(i, 2))
                    If a Then
                       For j = 4 To UBound(arr, 2)
                           dk = UCase(ten & "#" & arr(1, j))
                           b = dic.Item(dk)
                           If b Then
                              If arr(i, j) <> Empty Then
                               If b = 3 Then
                                  data(a, b) = arr(i, j) & " " & data(a, b)
                               Else
                                  data(a, b) = arr(i, j) + data(a, b)
                               End If
                             End If
                           End If
                       Next j
                  End If
             Next i
       End If
   Next
   With Sheets("master")
     .Range("A5:K227").Value = data
   End With
End Sub

Anh Snow25 giải thích giúp đoạn code này được không
If b Then
If arr(i, j) <> Empty Then
If b = 3 Then
data(a, b) = arr(i, j) & " " & data(a, b)
Else
data(a, b) = arr(i, j) + data(a, b)
Thanks anh!
 
Upvote 0
Upvote 0
Web KT
Back
Top Bottom