Đếm theo điều kiện ở nhiều workbook khác nhau (2 người xem)

[huonglien1901]

Chào mọi người!

Em có yêu cầu nhờ mọi người hỗ trợ.

Em muốn đếm theo điều kiện có bao nhiêu chữ C trong nhiều workbook khác nhau.(Trong ví dụ em đưa ra là Workbook A, Workbook B, Workbook C), vì số lượng dòng không giống nhau giữa các workbook, những file dữ liệu này nằm ở Sheet 1.

Em nhờ mọi người có thể đưa công thức tổng quát cho trường hợp này và code cho em học hỏi với.

Em cảm ơn mọi người nhiều!

 

[befaint]

Em muốn đếm theo điều kiện có bao nhiêu chữ C trong nhiều workbook khác nhau.(Trong ví dụ em đưa ra là Workbook A, Workbook B, Workbook C), vì số lượng dòng không giống nhau giữa các workbook, những file dữ liệu này nằm ở Sheet 1.

Gửi dữ liệu thật lên được không bạn?
Chứ chữ "cờ" thì đếm làm gì

 

[HieuCD]

Chào mọi người!

Em có yêu cầu nhờ mọi người hỗ trợ.

Em muốn đếm theo điều kiện có bao nhiêu chữ C trong nhiều workbook khác nhau.(Trong ví dụ em đưa ra là Workbook A, Workbook B, Workbook C), vì số lượng dòng không giống nhau giữa các workbook, những file dữ liệu này nằm ở Sheet 1.

Em nhờ mọi người có thể đưa công thức tổng quát cho trường hợp này và code cho em học hỏi với.

Em cảm ơn mọi người nhiều!

Nếu chỉ có 3 file
B2 =SUMPRODUCT(('D:\Downloads\[A.xls]Sheet1'!$A$1:$A$50=A2)*('D:\Downloads\[A.xls]Sheet1'!$B$1:$B$50="C"))+SUMPRODUCT(('D:\Downloads\[b.xls]Sheet1'!$A$1:$A$50=A2)*('D:\Downloads\[b.xls]Sheet1'!$B$1:$B$50="C"))+SUMPRODUCT(('D:\Downloads\[c.xls]Sheet1'!$A$1:$A$50=A2)*('D:\Downloads\[c.xls]Sheet1'!$B$1:$B$50="C"))
Chỉnh lại đường dẫn

 

[huonglien1901]

Nếu chỉ có 3 file
B2 =SUMPRODUCT(('D:\Downloads\[A.xls]Sheet1'!$A$1:$A$50=A2)*('D:\Downloads\[A.xls]Sheet1'!$B$1:$B$50="C"))+SUMPRODUCT(('D:\Downloads\[b.xls]Sheet1'!$A$1:$A$50=A2)*('D:\Downloads\[b.xls]Sheet1'!$B$1:$B$50="C"))+SUMPRODUCT(('D:\Downloads\[c.xls]Sheet1'!$A$1:$A$50=A2)*('D:\Downloads\[c.xls]Sheet1'!$B$1:$B$50="C"))
Chỉnh lại đường dẫn

Nếu nhiều file thì có công thức tổng quát cho trường hợp này không Anh?
Tại vì số dòng không giống nhau. Cách của Anh em cũng có nghĩ tới. Nhưng tại vì nhiều file thì công thức đó cũng chưa tối ưu lắm.

Em cảm ơn Anh đã hỗ trợ.

 

[HeSanbi]

Nếu nhiều file thì có công thức tổng quát cho trường hợp này không Anh?
Tại vì số dòng không giống nhau. Cách của Anh em cũng có nghĩ tới. Nhưng tại vì nhiều file thì công thức đó cũng chưa tối ưu lắm.

Em cảm ơn Anh đã hỗ trợ.

Dưới đây là Công thức lấy ô cuối cùng chứa dữ liệu, bạn xem và hoàn chỉnh công thức

Ví dụ:

=MAX(MATCH(9.99999999999999E+307,A1:A100),MATCH(REPT("z",255),A1:A100))
{=MATCH(2,1/(A1:A28<>""))}

Dùng Hàm INDERECT để chuyển chuỗi "A1:Ax" sang một Range Object
Ví dụ:

INDERECT("Sheet1!A1:A" & MAX(MATCH(9.99999999999999E+307,A1:A100),MATCH(REPT("z",255),A1:A100)))

 

[dazkangel]

Nếu nhiều file thì có công thức tổng quát cho trường hợp này không Anh?
Tại vì số dòng không giống nhau. Cách của Anh em cũng có nghĩ tới. Nhưng tại vì nhiều file thì công thức đó cũng chưa tối ưu lắm.

Em cảm ơn Anh đã hỗ trợ.

Thực tế chỉ hàm chỉ có cách đó nhé bạn, không có hàm nào gom các file lại được.

 

[huonglien1901]

Dưới đây là Công thức lấy ô cuối cùng chứa dữ liệu, bạn xem và hoàn chỉnh công thức

Ví dụ:

=MAX(MATCH(9.99999999999999E+307,A1:A100),MATCH(REPT("z",255),A1:A100))

Dùng Hàm INDERECT để chuyển chuỗi "A1:Ax" sang một Range Object
Ví dụ:

INDERECT("Sheet1!A1:A" & MAX(MATCH(9.99999999999999E+307,A1:A100),MATCH(REPT("z",255),A1:A100)))

Ví dụ trường hợp này code như thế nào vậy Anh?
Anh đưa code cho em học hỏi với.

Em.cảm ơn Anh.

 

[HeSanbi]

Không hiểu sao có VBA dễ dàng hơn bạn lại không sử dụng

Lấy đường dẫn chính:

A1=LEFT(CELL("filename",A1),FIND("\[",CELL("filename",A1)))

Lấy ô cuối cùng của file A.xls:

B1=MAX(MATCH(9.99999999999999E+307,INDERECT("'"&$A$1&"[A.xls]Sheet1'!A1:A1000000")),MATCH(REPT("z",255),INDERECT("'"&$A$1&"[A.xls]Sheet1'!A1:A1000000"))

Các công thức đếm thì đơn giản:

C1=SUMPRODUCT(INDERECT("'"&$A$1&"[A.xls]Sheet1'!A1:A"&B1)=A2)

Dựa vào công thức Bác HieuCD bạn tiếp tục

 

[huonglien1901]

Không hiểu sao có VBA dễ dàng hơn bạn lại không sử dụng

Lấy đường dẫn chính:

A1=LEFT(CELL("filename",A1),FIND("\[",CELL("filename",A1)))

Lấy ô cuối cùng của file A.xls:

B1=MAX(MATCH(9.99999999999999E+307,INDERECT("'"&$A$1&"[A.xls]Sheet1'!A1:A1000000")),MATCH(REPT("z",255),INDERECT("'"&$A$1&"[A.xls]Sheet1'!A1:A1000000"))

Các công thức đếm thì đơn giản:

C1=SUMPRODUCT(INDERECT("'"&$A$1&"[A.xls]Sheet1'!A1:A"&B1)=A2)

Dựa vào công thức Bác HieuCD bạn tiếp tục

Em muốn học hỏi cách làm của mọi người à.
Tại vì mỗi người có nhiều cách làm hay.
Em cảm ơn Anh nhiều!
Trường hợp này anh code cho em xem với.

 

[HeSanbi]

Em muốn học hỏi cách làm của mọi người à.
Tại vì mỗi người có nhiều cách làm hay.
Em cảm ơn Anh nhiều!
Trường hợp này anh code cho em xem với.

Bạn xem công thức được chưa, được rồi thì cần gì đến code, code viết vài đoạn code vui chơi, chứ viết thật kỉ, debug trước sau cũng không dể đâu
Hướng dẫn chơi chơi, bạn tự mày mò nhé
1. Quét qua các file trong thư mục nhưng chừa file chính lại:
Dùng thư viện FileSystemObject để duyệt thư mục
Set OSFSO = CreateObject("Scripting.FileSystemObject")
Dim OSFSO As New FileSystemObject sẽ dể viết code hơn

ThisWorkbook.FullName là file chính​

Thư mục sẽ là ThisWorkbook.Path​

Set SourceFolder = OSFSO .GetFolder(ThisWorkbook.Path)​

2. Sử dụng For Each để tìm kiếm file trong thư mục

For Each FileItem In SourceFolder.Files​

Kiểm tra nếu FileItem.Name = ThisWorkbook.FullName thì bỏ qua​

Còn không thì:​

Workbooks.Open FileItem.Name​

Hoặc Dùng ADOBC để thực hiện lúc này không cần mở Workbook lên.​

Set WS = Workbooks(FileItem.Name)​

With WS​

Tìm dòng cuối với Phương thức End(xlUp)​

Gán mảng Arr = .Range("A1:A" & DongCuoi).Value​

Cho vòng lặp chạy từ 1 đến dòng cuối​

Nếu Arr (i,1) bằng "C" thì K = K + 1​

End With​

Lưu lại biến K​

 

[huonglien1901]

Bạn xem công thức được chưa, được rồi thì cần gì đến code, code viết vài đoạn code vui chơi, chứ viết thật kỉ, debug trước sau cũng không dể đâu
Hướng dẫn chơi chơi, bạn tự mày mò nhé
1. Quét qua các file trong thư mục nhưng chừa file chính lại:
Dùng thư viện FileSystemObject để duyệt thư mục
Set OSFSO = CreateObject("Scripting.FileSystemObject")
Dim OSFSO As New FileSystemObject sẽ dể viết code hơn

ThisWorkbook.FullName là file chính​

Thư mục sẽ là ThisWorkbook.Path​

Set SourceFolder = OSFSO .GetFolder(ThisWorkbook.Path)​

2. Sử dụng For Each để tìm kiếm file trong thư mục

For Each FileItem In SourceFolder.Files​

Kiểm tra nếu FileItem.Name = ThisWorkbook.FullName thì bỏ qua​

Còn không thì:​

Workbooks.Open FileItem.Name​

Hoặc Dùng ADOBC để thực hiện lúc này không cần mở Workbook lên.​

Set WS = Workbooks(FileItem.Name)​

With WS​

Tìm dòng cuối với Phương thức End(xlUp)​

Gán mảng Arr = .Range("A1:A" & DongCuoi).Value​

Cho vòng lặp chạy từ 1 đến dòng cuối​

Nếu Arr (i,1) bằng "C" thì K = K + 1​

End With​

Lưu lại biến K​

Không hiểu sao có VBA dễ dàng hơn bạn lại không sử dụng

Lấy đường dẫn chính:

A1=LEFT(CELL("filename",A1),FIND("\[",CELL("filename",A1)))

Lấy ô cuối cùng của file A.xls:

B1=MAX(MATCH(9.99999999999999E+307,INDERECT("'"&$A$1&"[A.xls]Sheet1'!A1:A1000000")),MATCH(REPT("z",255),INDERECT("'"&$A$1&"[A.xls]Sheet1'!A1:A1000000"))

Các công thức đếm thì đơn giản:

C1=SUMPRODUCT(INDERECT("'"&$A$1&"[A.xls]Sheet1'!A1:A"&B1)=A2)

Dựa vào công thức Bác HieuCD bạn tiếp tục

Công thức em áp dụng vào nó báo lỗi #Name. không biết sai ở chỗ nào nữa.
Code thì em chưa làm được, Nhờ Anh hỗ trợ thêm.

Em cảm ơn mọi người nhiều!

 

[HeSanbi]

Nhìn thấy bạn Lượt bài viết, lượt thích gấp 3 lần tôi, vậy mà tôi muốn hướng dẫn bạn, có gì đó không đúng, không biết bạn giỏi về lĩnh vực nào của office và yếu trong lĩnh vực nào của office.
Các công thức cơ bản chỉ cần bạn cài Office Tiếng Việt thì gần như là bạn nắm vững kiến thức Công thức.
Cái khó là ở tư duy và phát huy cái tiềm năng tư duy, nếu thực là bạn có rồi thì mọi chuyện trở nên đơn giản hơn nếu bạn thực hành nhiều hơn nữa thì não bộ ghi nhớ của bạn sẽ lưu nhớ ngay, và sẽ khó quên (Bộ não là vô hạn)
Khi đó khu vực chất xám tư duy sẽ lấy ở não bộ ghi nhớ ra và tư duy.
Nếu bạn là nữ thì dùng chất xám nhiều sẽ mau già và tóc bạc sớm.

Nếu VBA mà bạn không vững thì xem qua bài viết ngu ngơ của tôi: Ngu ngơ VBA
Hãy thường chơi đùa với Code để não bộ ghi nhớ ghi nhớ theo logic mà mình cũng không thể tin được mình đang sở hữu nó.

Trong file dùng Công thức Tôi thay đổi hàm lấy dòng cuối:

{=MATCH(2,1/(A1:A10000<>""))}

Bạn nên Upload File, để 3 file trong 1 file được nén.

Code bên dưới dùng ADODB để thực hiện:

'Thêm 2 tools -> references..:
' 1. Microsoft Scripting Runtime
' 2. Microsoft ActiveX Data Objects x.x Library
'Thêm tools để người lập trình code dể dàng, và thêm thư viện cần thiết
Sub TèLeTùmLum()
  Dim cn 'As ADODB.Connection
  Dim rst 'As ADODB.Recordset
  Dim sql$, i&, j&, t&
  Dim FSO 'As New FileSystemObject
  Dim SF, Item, Arrs, Total(), Path$, tPath$, WS As Worksheet, Rng As Range
  Set WS = ThisWorkbook.Worksheets(1)
  t = WS.Cells(Rows.Count, 1).End(xlUp).Row
  Set Rng = WS.Range("A2:B" & t)
  t = UBound(Rng.Value)
  ReDim Total(1 To t)
  Path = ThisWorkbook.Path
  Set SF = FSO.GetFolder(Path)
  For Each Item In SF.Files
    If Item.Name <> ThisWorkbook.Name _
    And Not Item.Name Like "~*" Then
      tPath = Item.Path: GoSub ADO
    End If
  Next
Ends:
  WS.Range("B2").Resize(t).Value = Application.Transpose(Total)
  Set WS = Nothing: Set Rng = Nothing: Set SF = Nothing: Set Item = Nothing
  Exit Sub
ADO:
  Set cn = CreateObject("ADODB.connection")
  Set rst = CreateObject("ADODB.recordset")
  If Application.Version < 12 Then
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & tPath & _
          ";Extended Properties=""Excel 8.0;HDR=No;"";"
  Else
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & tPath & _
          ";Extended Properties=""Excel 12.0;HDR=No;"";"
  End If
  sql = "SELECT * FROM [Sheet1$A1:B65536]"
  rst.Open sql, cn, 3, 3, 1
  Arrs = rst.GetRows
  For i = LBound(Arrs, 2) To UBound(Arrs, 2)
    For j = 1 To t
      If Application.Trim$(Rng(j, 1).Value) = Application.Trim$(Arrs(0, i)) _
      And Arrs(1, i) = "C" Then
        Total(j) = Total(j) + 1
      End If
    Next
  Next
  Erase Arrs: rst.Close: cn.Close: Set cn = Nothing: Set rst = Nothing
Return
End Sub