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

vncws99

Thành viên mới
Tham gia ngày
10 Tháng tám 2015
Bài viết
7
Được thích
0
Điểm
163
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

snow25

Thành viên gắn bó
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,893
Được thích
1,646
Điểm
210
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
 

vncws99

Thành viên mới
Tham gia ngày
10 Tháng tám 2015
Bài viết
7
Được thích
0
Điểm
163
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:
 

Tuan_hcth

Thành viên hoạt động
Tham gia ngày
8 Tháng tư 2007
Bài viết
149
Được thích
10
Điểm
670
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)
Cảm ơn anh!
 
Top