Cách đếm "X" theo điều kiện (1 người xem)

[luuchanhtrung]

Mình có dữ liệu rất nhiều dòng, được đánh dấu bằng chữ "x"
Xin cho hỏi làm cách nào tìm được 3 dòng, sao cho nếu đếm theo từng cột thì tổng các chữ "x">=1.
sheet1 là mình làm Ví dụ. Còn sheet2 là dữ liệu thực tế xin chỉ giúp mình.
Thành thất cám ơn.

 

[ndu96081631]

Mình có dữ liệu rất nhiều dòng, được đánh dấu bằng chữ "x"
Xin cho hỏi làm cách nào tìm được 3 dòng, sao cho nếu đếm theo từng cột thì tổng các chữ "x">=1.
sheet1 là mình làm Ví dụ. Còn sheet2 là dữ liệu thực tế xin chỉ giúp mình.
Thành thất cám ơn.

Nghe mô tả (chưa xem file) thì thấy dường như hơi.. hiểu bạn nói gì
Sau khi xem file xong lại cảm thấy dường như.. ngu thêm ---> Vì càng xem lại càng không hiểu

 

[Hai Lúa Miền Tây]

Ý bạn muốn gì, đếm chữ "X" xem coi xuất hiện bao nhiêu lần ?
Nếu vậy thì dùng CountIf thôi

B8=COUNTIF(B3:B6,"x") --> kéo qua

Và bạn nên giải thích rõ với đề bài bạn đặt, nếu không bài của bạn sẽ bị xóa

 

[luuchanhtrung]

nghĩa là minh dùng hàm countif đếm đếm chữ "x", nhưng phải thõa mãn là tìm được 3 dòng mà sao cho đếm các chữ "x">=1 bạn a. Nghĩa là trên cùng một cột của 3 dòng này không có khoảng trắng.

Xin bạn đọc kỹ đề bài lại đi. Mình chỉ tìm trên 3 dòng thôi. 3 dòng này lại không liên tục và phải thõa mãn, như bạn nói đó "khi kéo qua " thì phải khác không (0) bạn à.
Vả lại dữ liệu mình có rất là nhiều dòng như vậy (khoảng 15.000 dòng).

 

[dat_butmuc]

Cũng như Bác Ndu, càng đọc càng không hiểu
Bạn có thể nói rõ hơn, ví dụ như:
-

Mình chỉ tìm trên 3 dòng thôi. 3 dòng này lại không liên tục

trên cùng một cột của 3 dòng này không có khoảng trắng

=> là 3 dòng nào hay theo quy luật gì?

-

đếm các chữ "x">=1

=> Cái này là sao đây ?

=> Bạn nói rõ từng yêu cầu được không (ví dụ trong từng dòng/cột)
Nếu không thì dùng như Bác Dom cũng ra kết quả như trong ví dụ của bạn ?

P/s: Bạn muốn có kết quả tốt thì cũng nên làm cho mọi người hiểu bạn muốn gì ?

 

[luuchanhtrung]

Thì mình mới nói là tối ưu hóa bạn à. Ba dòng này không có quy luật gì hết.
Nếu mà tìm mò mẫm thì rất là lâu (vì rất nhiều dòng như mình nói). Nên mình mới cần giúp đỡ của mọi người.
Tức là tìm ba dòng mà sao cho đếm chữ "x" theo cột của trên ba dòng này thì phải >=1.
Bạn lấy sheet2 thực tế sẽ thấy: nếu đếm trên 3 dòng 2,3,4 thì sẽ không thõa mãn. Có những cột trên 3 dòng 2,3,4 không có chữ "x" nào.
Do vậy phải mò tìm dòng 2,3,5..vv nếu không thõa lại phải mò tiếp tục. Nhưng số dòng thì rất là nhiều bạn à. (khoảng 15000 dòng như vậy).
Bạn hiểu ý mình nói không?

 

[conando]

mình làm xong rồi nè bạn xem coi có đung không

 

[luuchanhtrung]

Cám ơn bạn. Nhưng không phải thế bạn à.
Thực chất của bài toán là tìm 3 dòng (trong vô số rất nhiều dòng) sao cho đếm chữ "x" theo từng cột của 3 dòng này tất cả đồng thời phải >=1 (khác không).
Xin các bạn chỉ giúp cám ơn rất nhiều.
Lưu Chánh Trung.

 

[SA_DQ]

Thực chất của bài toán là tìm 3 dòng (trong vô số rất nhiều dòng) sao cho đếm chữ "x" theo từng cột của 3 dòng này tất cả đồng thời phải >=1 (khác không). Xin các bạn chỉ giúp cám ơn rất nhiều.
Lưu Chánh Trung.

Bài toán của bạn cách gì cũng vô nghiệm; Lý do: có đến 10 cột trống trơn, không có ký tự 'X' nào cả. Chỉ cần 1 trong chúng tồn tại là không có nghiệm rồi, phải không?

 

[luuchanhtrung]

Theo như sheet2 minh gui thì đúng bạn à.
Nhưng thực tế dữ liệu thì rất nhiều dòng chữ "x" như vậy (khoảng 15 ngàn dòng.)
Do đó mình nghĩ sẽ tìm được 3 dòng thõa mãn.
Bạn giúp mình nhé.
Bạn giúp mình tìm ra vị trí 3 dòng sao cho thõa mãn điều kiện mình nói ở trên, nếu vô nghiệm thì chương trình sẽ báo vô nghiệm. Nếu có nghiệm thì sẽ ra kết quả vị trí 3 dòng đó.
Thanks bạn rất nhiều.

 

[SA_DQ]

Thì bạn cứ gởi file dữ liệu gần thiệt lên đi: Mỗi trang tính có 5 ngàn dòng là OK rồi;
Chứ vô nghiệm làm dễ mà: duyệt theo cột đang được dùng; nếu cột nào không có 'X' thi báo kết quả cho bạn ngay!

Chờ file khác của bạn.

Bạn chạy macro này trên file của bạn:

Option Explicit
Sub Find3Rows()
 Dim lRow As Long, Col As Byte, jJ As Integer, Max_ As Long
 Dim Clls As Range, Rng As Range, sRng As Range
 Dim MyAdd As String
 
 With WorksheetFunction
   If .CountA(Cells) > 0 Then
      lRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, _
         SearchDirection:=xlPrevious).Row
      Col = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
         SearchDirection:=xlPrevious).Column
      Set Clls = Cells(lRow, Col)
   End If
   Cells(lRow + 3).EntireRow.Clear:            Max_ = lRow
1 ' Kiem Cot Rong & Cot Min:'
   For jJ = Col To 1 Step -1
      Set Rng = Cells(2, jJ).Resize(lRow)
      If .CountIf(Rng, "x") = 0 Then
         If sRng Is Nothing Then
            Set sRng = Rng.Cells(1, 1)
         Else
            Set sRng = Union(sRng, Rng.Cells(1, 1))
         End If
      Else
         If .CountIf(Rng, "x") <= Max_ Then
            Max_ = .CountIf(Rng, "x"):    Cells(1, jJ) = Max_
         End If
      End If
   Next jJ
 End With
 If Not sRng Is Nothing Then MsgBox sRng.Address, , "Cot Dang Rong:"
End Sub

Macro sẽ:
(*) Báo bạn biết khi có cột rỗng
(*) Liệt kê số từ 'x" có trong mỗi cột (theo hướng tăng dần). Chuyện này rất cần cho giái fáp tiếp theo là để tìm 3 dòng thỏa điều kiện cho bạn.

Hãy thử trên file của bạn & cho biết kết quả, nha. Xin cảm ơn!

 

[luuchanhtrung]

Đây là file thực tế bạn giúp mình hé. Đây là link:

http://www.mediafire.com/?nwkdn4efmzm

Có một cột mà không có chữ "x" nào, ban delete cột đó dùm mình hé.
Xin thành thật cám ơn bạn.
Lưu Chánh Trung

 

[SA_DQ]

Từ hơn 11 ngàn dòng chuyển về 2299 dòng đây

Option Explicit
Sub Find3Rows()
 Dim lRow As Long, Col As Byte, jJ As Integer, Max_ As Long
 Dim Clls As Range, Rng As Range, Sh As Worksheet, dRng As Range
 Dim MyAdd As String
  
 Sheets("S0").Select '<=| Sheet Du Lieu Nguon'
 lRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, _
   SearchDirection:=xlPrevious).Row
 Col = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
   SearchDirection:=xlPrevious).Column
 Set Clls = Cells(lRow, Col):          Application.ScreenUpdating = False
 Cells(lRow + 3).EntireRow.Clear:            Max_ = lRow
 
 With WorksheetFunction
1 ' Kiem Cot Rong & Cot Min:'
   For jJ = Col To 1 Step -1
      Set Rng = Cells(2, jJ).Resize(lRow)
      If .CountIf(Rng, "x") = 0 Then
11 ' Tô màu Dàu Cot Rong'
         Cells(1, jJ).Interior.ColorIndex = 38
      Else
12 ' Ghi Luong "x" Trong Cot:'
         If .CountIf(Rng, "x") <= Max_ Then
            Max_ = .CountIf(Rng, "x"):    Cells(1, jJ) = Max_
         End If
      End If
   Next jJ
 End With
2 ' Copy Sang Trang Sh2 Nhung Dong Có x Trong Cot Min:'
 Set Clls = Cells(1, 1).End(xlToRight)
 Set Rng = Range(Clls.End(xlDown), Cells(lRow + Col, Clls.Column).End(xlUp))
 Set Sh = Sheets("S1"):                Sh.Cells.Clear    'Sheet Chua Du Lieu Dich'
 For Each Clls In Rng
   If Clls.Value = "x" Then
      With Sh.[A65500].End(xlUp)
         Clls.EntireRow.Copy Destination:=.Offset(1)
      End With
   End If
 Next Clls
 
End Sub

Macro đã tô màu nền tại cột trống dữ liệu; Đó là cột 'AS'
Macro đã chép các dòng có khả năng thỏa điều kiện sang S1;

Nếu bạn cần khảo sát tiếp để tìm cặp 3 các dòng thỏa điều kiện, thì cần xóa cột 'AS' này đi.

Chờ tin bạn.

 

[luuchanhtrung]

Mình đã xóa cột "AS" rồi và lấy những dòng chương tình đưa ra, nhưng không có 3 dòng nào thõa mãn đk như vậy bạn à. Bạn coi lại giúp mình hé.
Bạn xóa cột "AS" luôn dùm mình hé. Thế chương trình đưa ra được 3 dòng thõa mãn điều kiện không? Nếu có bạn chỉ dùm mình 3 dòng đó luôn hé (tô màu hoặc chỉ ra vị trí 3 dòng đó hé). Nếu theo dữ liệu mình đưa mà không tìm được 3 dòng thõa mãn điều kiện. Thì bạn tìm giúp dùm 4 hoặc 5 dòng hoặc...dòng mà sao cho số dòng ít nhất thõa mãn điều kiện như mình nói (đếm chữ "x" theo từng cột của những dòng này>=1).
Thành thật cảm ơn bạn.
Lưu Chánh Trung

 

[SA_DQ]

Vật lộn với nó hai buổi luôn

Option Explicit
Dim lRow As Long, Col As Byte, Max_ As Long

]Sub Find3Rows()
 Dim jJ As Long, Timer_ As Double
  
 Sheets("S0").Select:            Timer_ = Timer
 lRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, _
   SearchDirection:=xlPrevious).Row
 Col = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, _
   SearchDirection:=xlPrevious).Column
 Max_ = 0:                          jJ = 2
 Do
   If jJ + 5 >= lRow Then Exit Do
   ToMau jJ
 Loop
 MsgBox "Xong Ròi!", , "TGian:" & Timer - Timer_
End Sub

' * * * * * * * * * * '​

​

​

Sub ToMau(jJ As Long)
 Dim Ww As Byte, Dem As Long, Cot As Long
 Dim Rng As Range, Clls As Range
 
 For Ww = 3 To Col - 2
   If Cells(jJ, Ww).Value = "" Then
      Set Rng = Cells(jJ, Ww).Resize(lRow - jJ)
      Dem = 0
      For Each Clls In Rng
         
         If Clls.Value = "" Then
            Dem = Dem + 1
            If Clls.Row - jJ > Max_ Then _
               Clls.Interior.ColorIndex = 35 + Ww Mod 7
            If Clls.Row - jJ > Max_ Then Max_ = Clls.Row - jJ
         Else 'If Clls.Value = "x" Then
            Dem = 0:               Exit For
         End If
      Next Clls
   End If
 Next Ww
 jJ = jJ + Max_ - 3:          Max_ = 0
End Sub

Nhờ hỗ trợ của các macro, chúng ta biết tại sao không có hàng nào thỏa điều kiện.

 

[luuchanhtrung]

Trước hết vô cùng cám ơn bạn. Mình đã hiểu ý tưởng của bạn rồi.
Thế bạn làm tiếp dùm mình luôn là tìm số dòng nhỏ nhất và kết quả sẽ chỉ ra những dòng này sao cho nếu đếm chữ "x" theo cột của những dòng này thì phải khác không (>=1) luôn nhé.
Thành thật vô cùng cám ơn.

 

[SA_DQ]

Thực là chưa hiểu ý bạn lắm.

Thế bạn làm tiếp dùm mình luôn là tìm số dòng nhỏ nhất và kết quả sẽ chỉ ra những dòng này sao cho nếu đếm chữ "x" theo cột của những dòng này thì phải khác không (>=1) luôn nhé.

Hay bạn đưa file như #1 lên đễ hiểu thêm chút đi!

Chờ file của bạn; Thân!

 

[luuchanhtrung]

Tức là ta đã chứng mình được rằng nếu 3 dòng thì không thể thỏa mãn điều kiện.
Bây giờ ta sẽ xét trên 4 dòng, nếu không thỏa mãn thì tiếp tục xét trên 5 dòng, vân vân...
Đây là file mình gửi bạn xem nhé.
http://www.mediafire.com/?jo4yyqmrvdm

Chờ tin của bạn.
Cám ơn đã quan tâm

 

[SA_DQ]

Giải đáp trường hợp tổng quát luôn, vậy nghe!

Tại macro sau, bạn khai báo thêm 1 hằng số & chỉnh 1 dòng lệnh, như sau:

Sub ToMau(jJ As Long)
 Dim Ww As Byte, Dem As Long, Cot As Long
 Dim Rng As Range, Clls As Range
 Const Shg As Byte = 4  '<=|'
 
 For Ww = 3 To Col - 2
   If Cells(jJ, Ww).Value = "" Then
      Set Rng = Cells(jJ, Ww).Resize(lRow - jJ)
      Dem = 0
      For Each Clls In Rng
         
         If Clls.Value = "" Then
            Dem = Dem + 1
            If Clls.Row - jJ > Max_ Then _
               Clls.Interior.ColorIndex = 35 + Ww Mod 7
            If Clls.Row - jJ > Max_ Then Max_ = Clls.Row - jJ
         Else 'If Clls.Value = "x" Then'
            Dem = 0:               Exit For
         End If
      Next Clls
   End If
 Next Ww
 jJ = jJ + Max_ - Shg:          Max_ = 0   '<=|'
End Sub

& Sau đó bạn cứ tha hồ tăng dần hằng số cho đến khi tìm được nghiệm;
Cách tìm nghiệm thì tạm bằng chuột & bằng mắt. Rỗi rảnh, tìm sẽ ngâm cứu để tự động hóa chu trình đó sau.

Chúc vui trước khi bước vô tuần mới!

 

[luuchanhtrung]

Mình không hiểu lắm bạn à.
Đây là file mà mình đã tìm được 9 dòng thõa mãn điều kiện.
Mình muốn tìm số dòng càng nhỏ càng tốt mà thỏa mãn điều kiện. Ban giúp mình luôn hé. Kết quả trích xuất ra như file VD mà mình gửi cho bạn. Kết quả phải lấy ra những dòng này trên một sheet khác.
Chúc bạn có một ngày đầu tuần vui vẻ.
Lưu Chánh Trung