Dò tìm 2 điều kiện từ nhiều sheet (2 người xem)

kydang1989 · 21/11/14

Xin cháo các a/ce GPE
Mình có 1 sheet "check" cần tổng hợp dữ liệu từ các sheet con (có gần 50 sheet)
Cách mình làm thủ công: vào từng sheet, copy mã hàng, rồi vào sheet "Check", ctrl +F, tìm xem mã hàng nó nằm ở dòng nào, rồi vlookup với sheet đó. Cứ như thế làm từng sheet rất cực
Cho mình hỏi có thể dùng VBA hay dùng hàm trong excel để dò tìm nhiều sheet không?
trong file đính kèm mình chỉ để 1 sheet "check" cần tổng hợp và 2 sheet con

Ba Tê · 21/11/14

kydang1989 đã viết:
Xin cháo các a/ce GPE
Mình có 1 sheet "check" cần tổng hợp dữ liệu từ các sheet con (có gần 50 sheet)
Cách mình làm thủ công: vào từng sheet, copy mã hàng, rồi vào sheet "Check", ctrl +F, tìm xem mã hàng nó nằm ở dòng nào, rồi vlookup với sheet đó. Cứ như thế làm từng sheet rất cực
Cho mình hỏi có thể dùng VBA hay dùng hàm trong excel để dò tìm nhiều sheet không?
trong file đính kèm mình chỉ để 1 sheet "check" cần tổng hợp và 2 sheet con

Chỉ 1 sheet "Check" còn bi nhiêu là sheet con?

PHP:

Public Sub GPE()
Dim Dic As Object, Ws As Worksheet, sArr(), dArr(), I As Long, Tem As String, MH As String, N As Long
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
    If Ws.Name <> "Check" Then
        sArr = Ws.Range(Ws.[B14], Ws.[B14].End(xlDown)).Resize(, 6).Value2
        MH = Ws.[C5].Value2
        For I = 1 To UBound(sArr, 1)
            Tem = MH & sArr(I, 1)
            If Not Dic.Exists(Tem) Then Dic.Add Tem, sArr(I, 6)
        Next I
    End If
Next Ws
With Sheets("Check")
    sArr = .Range(.[B3], .[C65536].End(xlUp).Offset(1)).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 1) <> Empty Then MH = sArr(I, 1)
        If sArr(I, 2) <> Empty Then
            Tem = MH & sArr(I, 2)
            N = N + 1
            If Dic.Exists(Tem) Then dArr(I, 1) = Dic.Item(Tem)
        Else
            dArr(I, 1) = "=SUM(R[-" & N & "]C:R[-1]C)"
            N = 0
        End If
    Next I
    .[E3:E10000].ClearContents
    .[E3].Resize(I - 1) = dArr
    .[E3].Resize(I - 1).Value = .[E3].Resize(I - 1).Value
End With
Set Dic = Nothing
End Sub

kydang1989 · 21/11/14

Ba Tê đã viết:

Chỉ 1 sheet "Check" còn bi nhiêu là sheet con?

PHP:

Public Sub GPE()
Dim Dic As Object, Ws As Worksheet, sArr(), dArr(), I As Long, Tem As String, MH As String, N As Long
Set Dic = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
    If Ws.Name <> "Check" Then
        sArr = Ws.Range(Ws.[B14], Ws.[B14].End(xlDown)).Resize(, 6).Value2
        MH = Ws.[C5].Value2
        For I = 1 To UBound(sArr, 1)
            Tem = MH & sArr(I, 1)
            If Not Dic.Exists(Tem) Then Dic.Add Tem, sArr(I, 6)
        Next I
    End If
Next Ws
With Sheets("Check")
    sArr = .Range(.[B3], .[C65536].End(xlUp).Offset(1)).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 1)
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 1) <> Empty Then MH = sArr(I, 1)
        If sArr(I, 2) <> Empty Then
            Tem = MH & sArr(I, 2)
            N = N + 1
            If Dic.Exists(Tem) Then dArr(I, 1) = Dic.Item(Tem)
        Else
            dArr(I, 1) = "=SUM(R[-" & N & "]C:R[-1]C)"
            N = 0
        End If
    Next I
    .[E3:E10000].ClearContents
    .[E3].Resize(I - 1) = dArr
    .[E3].Resize(I - 1).Value = .[E3].Resize(I - 1).Value
End With
Set Dic = Nothing
End Sub

Code hay quá, cảm ơn bạn /-*+/

chứ cái file đó nếu làm thủ công mình làm cả ngày trời chưa xong, hihi

Quang_Hải · 21/11/14

kydang1989 đã viết:
Xin cháo các a/ce GPE
Mình có 1 sheet "check" cần tổng hợp dữ liệu từ các sheet con (có gần 50 sheet)
Cách mình làm thủ công: vào từng sheet, copy mã hàng, rồi vào sheet "Check", ctrl +F, tìm xem mã hàng nó nằm ở dòng nào, rồi vlookup với sheet đó. Cứ như thế làm từng sheet rất cực
Cho mình hỏi có thể dùng VBA hay dùng hàm trong excel để dò tìm nhiều sheet không?
trong file đính kèm mình chỉ để 1 sheet "check" cần tổng hợp và 2 sheet con

Tha hồ chọn lựa

PHP:

Option Explicit
Public Dic As Object
Sub check()
Dim sh As Worksheet, Code, MaHang
Dim Sarr(), Data(), i&, k&
With Sheet1
   Sarr = .Range("B3", .[D65536].End(3)).FormulaR1C1
   ReDim Preserve Sarr(1 To UBound(Sarr), 1 To 6)
   Gom Sarr, UBound(Sarr, 2)
   For Each sh In Worksheets
      If sh.Name <> "Check" Then
         MaHang = sh.[C5].Value
         Data = sh.Range("B14", sh.[G65536].End(3)).Value
         For i = 1 To UBound(Data)
            Code = MaHang & Data(i, 1)
            If Dic.exists(Code) Then
               k = Dic.Item(Code)
               Sarr(k, 4) = Data(i, 6)
               Sarr(k, 5) = Sarr(k, 3) - Sarr(k, 4)
            End If
         Next
      End If
   Next
   .[B3].Resize(UBound(Sarr), 5) = Sarr
End With
Set Dic = Nothing
End Sub
Sub Gom(Arr, Extra)
Dim i As Long
Set Dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(Arr)
   If Arr(i, 2) <> "" Then
      If Arr(i, 1) <> "" Then
         Arr(i, Extra) = Arr(i, 1)
      Else
         Arr(i, Extra) = Arr(i - 1, Extra)
      End If
      Dic.Add Arr(i, Extra) & Arr(i, 2), i
   Else
      Arr(i, 4) = Arr(i, 3)
      Arr(i, 5) = Arr(i, 4)
   End If
Next
End Sub

kydang1989 · 21/11/14

quanghai1969 đã viết:

Tha hồ chọn lựa

PHP:

Option Explicit
Public Dic As Object
Sub check()
Dim sh As Worksheet, Code, MaHang
Dim Sarr(), Data(), i&, k&
With Sheet1
   Sarr = .Range("B3", .[D65536].End(3)).FormulaR1C1
   ReDim Preserve Sarr(1 To UBound(Sarr), 1 To 6)
   Gom Sarr, UBound(Sarr, 2)
   For Each sh In Worksheets
      If sh.Name <> "Check" Then
         MaHang = sh.[C5].Value
         Data = sh.Range("B14", sh.[G65536].End(3)).Value
         For i = 1 To UBound(Data)
            Code = MaHang & Data(i, 1)
            If Dic.exists(Code) Then
               k = Dic.Item(Code)
               Sarr(k, 4) = Data(i, 6)
               Sarr(k, 5) = Sarr(k, 3) - Sarr(k, 4)
            End If
         Next
      End If
   Next
   .[B3].Resize(UBound(Sarr), 5) = Sarr
End With
Set Dic = Nothing
End Sub
Sub Gom(Arr, Extra)
Dim i As Long
Set Dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(Arr)
   If Arr(i, 2) <> "" Then
      If Arr(i, 1) <> "" Then
         Arr(i, Extra) = Arr(i, 1)
      Else
         Arr(i, Extra) = Arr(i - 1, Extra)
      End If
      Dic.Add Arr(i, Extra) & Arr(i, 2), i
   Else
      Arr(i, 4) = Arr(i, 3)
      Arr(i, 5) = Arr(i, 4)
   End If
Next
End Sub

cảm ơn bạn nhiều nhé :-=

Dò tìm 2 điều kiện từ nhiều sheet (2 người xem)

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

kydang1989

Thành viên chính thức

File đính kèm

Ba Tê

Cạo Rồi Khỏi Gội

kydang1989

Thành viên chính thức

Quang_Hải

Thành viên gạo cội

kydang1989

Thành viên chính thức

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

Thời gian đếm ngược.