Cần sự giúp đỡ để lọc dữ liệu!!! (1 người xem)

[sontvxd10]

Chào tất cả các bạn trong 4f. Mình mới tập tành sử dụng VBA nên rất cần sự chỉ giáo của các bạn.
Cụ thể là yêu cầu của mình như sau:


Mình muốn đánh dấu (*) vào cột K ở những hàng có giá trị lớn nhất, nhỏ nhất và trung bình ở cột C cụ thể ở trong hình này là:
Với B1 là các giá trị: 0.11, 1.8 và 3.49
Với B10 là: 0.11, 0.9 và 1.8.
Mình cũng đã thư làm 1 đoạn code để điều khiển cái Button như sau:

Private Sub CommandButton1_Click()

Dim i, j, n As Integer
Dim max, min, tb As Double
n = 4
Do While Cells(n, "B") <> ""
n = n + 1
Loop
n = n - 1
i = 4
j = 4
Cells(j, "K") = "*"
'danh dau * cac gia tri can thiet
For i = j To n
If Cells(i, "B") = Cells(i + 1, "B") Then
If Cells(j, "D") <= Cells(i + 1, "D") Then
Cells(j, "K") = "*"
min = Cells(j, "D")
End If
If Cells(j, "D") >= Cells(i + 1, "D") Then
Cells(j, "K") = "*"
max = Cells(j, "D")
End If
tb = max + min
If Cells(j, "D") = tb Then
Cells(j, "K") = "*"
End If
Else
j = i + 1
Cells(j, "K") = "*"
End If
Next i
End Sub

Nhưng khi chạy nó chỉ đánh dấu (*) tùm lum.
Rất mong các bạn cho ý kiến. Cảm ơn nhiều!!

 

[sontvxd10]

Gửi các bạn cái link file excel do mình ko biết attack file vào đâu cả
http://www.mediafire.com/?j6iqqgapbkn2dy7

 

[SA_DQ]

F ương án đề xuất của mình với bạn là vầy:

Khai báo thêm 1 biến đối tượng WF &

Set WF=Application.WorkSheetFunction;

Rồi tính trị MAX , MIN cũng như hàm trung bình tại cột 'C" nhờ vào hàm MAX() & MIN(),. . trong Excel

Dùng fương thức FIND() hay duyệt toàn cột so với 3 trị tìm được là OK thôi;

Sẽ có rắc rối khi trị trung bình tìm được bằng hàm sẽ không trùng với trị nào trên cột cả.


Có gì khó khăn fát biểu tiếp nha


Còn mình xin lưu í bạn 1 số điều sau:

(*) Khai báo các biến tường minh hơn;

không fải

 Dim i, j, n As Integer
Dim max, min, tb As Double

Mà fải là :

Dim i As Long, j As Long, n As Long
Dim maX As Long, miN As Long, tB As Double

(*) Thường thì mình không xài i & n làm biến, mà thay vào đó là Ww hay zZ, fF (lí do ư: Bàn fím sẽ hư đều ở các fím)



Chúc bạn tiến bộ!

 

[sontvxd10]

Khai báo thêm 1 biến đối tượng WF &

Set WF=Application.WorkSheetFunction;

Rồi tính trị MAX , MIN cũng như hàm trung bình tại cột 'C" nhờ vào hàm MAX() & MIN(),. . trong Excel

Dùng fương thức FIND() hay duyệt toàn cột so với 3 trị tìm được là OK thôi;

Sẽ có rắc rối khi trị trung bình tìm được bằng hàm sẽ không trùng với trị nào trên cột cả.

Cảm ơn các ý kiến của bạn. Để mình bơi tiếp xem sao đã. Khi nào đuối thì nhờ bạn vứt phao vậy. Còn cái vụ mòn phím thì chắc ko sao.

 

[concogia]

Cảm ơn các ý kiến của bạn. Để mình bơi tiếp xem sao đã. Khi nào đuối thì nhờ bạn vứt phao vậy. Còn cái vụ mòn phím thì chắc ko sao.

Mình thử bơi "zí" bạn một phát xem sao
Thật ra không biết tính trung bình ra mần răng nữa nên làm đại, nếu trật thì thì bạn nhờ ....bác Sa_QD làm nhé
Với dữ liệu hiện tại đã được sắp xếp như thế thì thử code này xem sao

Public Sub tim()
Dim Vung As Range, Wf, iMax As Double, iMin As Double, iMid As Double, VgDem As Range, I As Long, Bd As Long, A As Long
Set Wf = Application.WorksheetFunction:  Set Vung = Range([a4], [a50000].End(xlUp))
    For I = 1 To Vung.Rows.Count
        If Vung(I) = Vung(I + 1) Then
            Bd = Wf.Match(Vung(I), Vung, 0) + 3
            Set VgDem = Cells(Bd, 1).Resize(Wf.CountIf(Vung, Vung(I))).Offset(, 2)
            iMax = Wf.max(VgDem): iMin = Wf.min(VgDem): iMid = Wf.Median(VgDem)
                If Vung(I).Offset(, 2) = iMax Or Vung(I).Offset(0, 2) = iMin Or Vung(I).Offset(0, 2) = iMid Then Vung(I).Offset(, 10) = "*"
                A = A + 1
        Else
                    If Vung(I) = Vung(I - 1) And Vung(I) <> Vung(I + 1) Then Vung(I).Offset(, 10) = "*"
                    A = A + 1
        End If
Next
End Sub

Chưa nghĩ cách nào khác cho gọn và chạy nhanh hơn, làm đại lấy trớn đi ......đã, tối tính tiếp
Thân

 

[sontvxd10]

Mình thử bơi "zí" bạn một phát xem sao
Thật ra không biết tính trung bình ra mần răng nữa nên làm đại, nếu trật thì thì bạn nhờ ....bác Sa_QD làm nhé
Với dữ liệu hiện tại đã được sắp xếp như thế thì thử code này xem sao
Chưa nghĩ cách nào khác cho gọn và chạy nhanh hơn, làm đại lấy trớn đi ......đã, tối tính tiếp
Thân

Bó tay với bác. Quá Pro luôn. Em cóp vô chạy thấy quá ổn luôn. Mấy hàm bác dùng em vẫn chưa hiểu hết để tối em mò lại xem.
Hê hê, Em chỉ là tay ngang mới tự mò. Cả chiều bơi đc từng này đây bác

Dim i, n, dau, cuoi As Integer
Dim max, min, tb As Double
n = 4
Do While Cells(n, "A") <> ""
    n = n + 1
    Loop
    n = n - 1
    i = 4
    dau = 4
    For i = 4 To n
        If Cells(i, "A") = Cells(i + 1, "A") Then
        cuoi = i + 1
        Else
        min = Application.WorksheetFunction.min(Range(Cells(dau, "C"), Cells(cuoi, "C")))
        max = Application.WorksheetFunction.max(Range(Cells(dau, "C"), Cells(cuoi, "C")))
        tb = (max + min) / 2
        Cells(dau - 1, "K") = min
        Cells(dau, "K") = tb
        Cells(dau + 1, "K") = max
        End If
        dau = cuoi
    Next i
End Sub

Em muốn dùng giá trị "dau" và "cuoi" để giới hạn vùng tìm max và min. Nhưng khi chạy thì giá trị đầu nó không nhận như mình mong muốn. Bác thử xem và góp ý xem đoạn Code này của em có dùng đc không? Và nếu dùng phải chỉnh sửa ra sao?

 

[sontvxd10]

Hix vẫn ko đủ bác ơi. Em chạy code của bác thì thấy ở B15 vẫn không đánh đc dấu (*) ở giá trị trung bình. Bác thử ktra lại xem file excell em đã úp ở phần trên đó. Nhân tiện bác cho em hỏi là vai trò của biến "A" trong đoạn Code của bác làm gì vậy??

 

[concogia]

Hix vẫn ko đủ bác ơi. Em chạy code của bác thì thấy ở B15 vẫn không đánh đc dấu (*) ở giá trị trung bình. Bác thử ktra lại xem file excell em đã úp ở phần trên đó. Nhân tiện bác cho em hỏi là vai trò của biến "A" trong đoạn Code của bác làm gì vậy??

Hihi, thì mình đã nói với bạn mình không biết cái "thằng" trung bình mặt mũi ra sao mà nên làm đại
"Bi" giờ thì biết rồi, bạn sửa cái "thằng" iMid tí xong chạy lại thử xem
iMid = Wf.Round((iMax + iMin) / 2, 3)
Thân
Biến A để cố định cell đầu tiên trong vùng dữ liệu muốn đếm

 

[SA_DQ]

. . mình không biết cái "thằng" trung bình mặt mũi ra sao mà nên làm đại
"Bi" giờ thì biết rồi, bạn sửa cái "thằng" iMid tí xong chạy lại thử xem
iMid = Wf.Round((iMax + iMin) / 2, 3)
Thân

Tính như vậy thì biến iMid là giá trị trung đoạn, chứ đâu fải trung bình đâu ta?!

Tính trung bình có thể 1 trong 2 cách iMid = Sum (LoopkUpRange)/Count(LookUpRange)
Hay dùng hàm của excel chứ bộ?

 

[concogia]

Tính như vậy thì biến iMid là giá trị trung đoạn, chứ đâu fải trung bình đâu ta?!

Tính trung bình có thể 1 trong 2 cách iMid = Sum (LoopkUpRange)/Count(LookUpRange)
Hay dùng hàm của excel chứ bộ?

Híc, nhìn "zô" trong bài của chủ topic thấy tính cái gọi là trung bình như "zị" đó bác ơi
"Trung bình" là tên gọi thôi mà, còn tính mần sao thì ăn thua mình giao với nhau thôi
Híc

 

[sontvxd10]

Ah đúng rồi. Em hiểu rồi. Ý của em là tb ở đây là (max+min)/2 chứ không phải là "tổng các phần tử"/"số phần tử". Ô B15 không đánh "*" đc là do nó không tìm đc trị tb khi dùng hàm median(). Đọc đoạn Code của bác concogia tưởng biến A không có vai trò gì em bỏ đi. Thấy vẫn chạy bt. Nếu cứ bỏ đi thì có vấn đề gì không bác. Nhân tiện em hỏi thêm luôn. Đó là khi lọc ra thì có những đoạn nó ra 4 trị iMid. Nhưng em chỉ muốn lấy 2 giá trị ứng với 2 giá trị max và min của cột I. Thì cách giải quyết tốt nhất là ra sao nhỉ 2 bác??

 

[concogia]

Ah đúng rồi. Em hiểu rồi. Ý của em là tb ở đây là (max+min)/2 chứ không phải là "tổng các phần tử"/"số phần tử". Ô B15 không đánh "*" đc là do nó không tìm đc trị tb khi dùng hàm median(). Đọc đoạn Code của bác concogia tưởng biến A không có vai trò gì em bỏ đi. Thấy vẫn chạy bt. Nếu cứ bỏ đi thì có vấn đề gì không bác. Nhân tiện em hỏi thêm luôn. Đó là khi lọc ra thì có những đoạn nó ra 4 trị iMid. Nhưng em chỉ muốn lấy 2 giá trị ứng với 2 giá trị max và min của cột I. Thì cách giải quyết tốt nhất là ra sao nhỉ 2 bác??

Câu 1- Bỏ biến A đi thì cell đầu của vung tham chiếu để tìm Max, Min...sẽ chạy theo I ==> kết quả ra "trật lấc"
Câu 2- Cái này khó quá bạn nhờ Thầy của mình là Thầy Ptm hoặc Thầy Sa_DQ làm giúp nhé
Thân

 

[sontvxd10]

Cám ơn bác. Để em mò tiếp xem sao đã.

 

[ThuNghi]

Ah đúng rồi. Em hiểu rồi. Ý của em là tb ở đây là (max+min)/2 chứ không phải là "tổng các phần tử"/"số phần tử". Ô B15 không đánh "*" đc là do nó không tìm đc trị tb khi dùng hàm median(). Đọc đoạn Code của bác concogia tưởng biến A không có vai trò gì em bỏ đi. Thấy vẫn chạy bt. Nếu cứ bỏ đi thì có vấn đề gì không bác. Nhân tiện em hỏi thêm luôn. Đó là khi lọc ra thì có những đoạn nó ra 4 trị iMid. Nhưng em chỉ muốn lấy 2 giá trị ứng với 2 giá trị max và min của cột I. Thì cách giải quyết tốt nhất là ra sao nhỉ 2 bác??

Cho tôi hỏi với A=B15 và xét theo cột B (Loc)
1/ Max = 3.49
2/ Min = 0.11
3/ Danh sach duy nhất là 12 số
4/ Và median(danh sach duy nhất) = 2.325
Vậy lấy số hạng thứ 6 = 2.25 hay số 7=2.4. Trướng hợp như với B1 thì dễ hơn vì có 5 số hạng => số giữa là số thứ 3= 1.8.
Bạn cụ thể hơn vấn đề này. Với lại những cột khác kg có tham gia thì mình kg nên đưa vào yêu cầu, nhìn vào sẽ rối.

 

[sontvxd10]

Cho tôi hỏi với A=B15 và xét theo cột B (Loc)
1/ Max = 3.49
2/ Min = 0.11
3/ Danh sach duy nhất là 12 số
4/ Và median(danh sach duy nhất) = 2.325
Vậy lấy số hạng thứ 6 = 2.25 hay số 7=2.4. Trướng hợp như với B1 thì dễ hơn vì có 5 số hạng => số giữa là số thứ 3= 1.8.
Bạn cụ thể hơn vấn đề này. Với lại những cột khác kg có tham gia thì mình kg nên đưa vào yêu cầu, nhìn vào sẽ rối.

Không phải bác ơi. Em chỉ lấy trị TB tức là : (Max+min)/2 thôi. Ứng với B15 là: (3.49+0.11)/2 là 1.8 đó.

 

[SA_DQ]

À há! Hai chàng này định áp đặt lệ làng lên fép vua ư?

(SPAM 1 cái & nhờ MODs/SMODs ngang qua đây xóa dùm & Rất cảm ơn!)

Thuật ngữ Trung bình đã đi vào lòng người rồi & không ăn nhập gì với định nghĩa của hai cha cả!

Đúng ra đó là giá trị trung bình cộng của cực trị. Thà dài dòng, nhưng không lấn chiếm lòng lề đường tẹo nào.

Như hai bạn, riết rồi 'E' lên nằm trên 'A' trong chuỗi chữ cái mất thôi!

 

[sontvxd10]

Cảm ơn bác đã sửa dùm. Tại em quen cứ thấy giữa giữa là gọi trung bình thôi.

 

[ThuNghi]

Không phải bác ơi. Em chỉ lấy trị TB tức là : (Max+min)/2 thôi. Ứng với B15 là: (3.49+0.11)/2 là 1.8 đó.

Vậy B10:
Max=1.8
Min=0.11
=> (Max+min)/2=1.91/2=0.955
Trong khi median =0.9.
Vậy lấy cái nào.

 

[sontvxd10]

Em chỉ lấy giá trị (max + min)/2 bác ah. Với B10 thì là 0.995 là không có nên em cũng không cần lấy. Em là dân kết cấu xây dựng. Cái B10 là cái dầm consol nên chỉ cần giá trị đầu và cuối thôi.

 

[ThuNghi]

Em chỉ lấy giá trị (max + min)/2 bác ah. Với B10 thì là 0.995 là không có nên em cũng không cần lấy. Em là dân kết cấu xây dựng. Cái B10 là cái dầm consol nên chỉ cần giá trị đầu và cuối thôi.

Vậy là nếu (max + min)/2 mà không có trong cột Loc tương ứng thì không lấy. Chỉ lấy max và min thôi. Hiểu yêu cầu thì dễ làm hơn.
Bạn đổi tên sh Nguồn thành "data" và dùng code sau thử.

Option Explicit
Dim Dic As Object, sTmp As String
Dim endR As Long, i As Long, s As Long, k As Long
Dim Arr01, Arr02, Arr, ArrKQ
Sub Danhdau()
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Data")
  endR = .Cells(65000, 1).End(xlUp).Row
  Arr01 = .Range("A2:A" & endR)
  Arr02 = .Range("C2:C" & endR)
End With
ReDim Arr(1 To endR - 1, 1 To 4)
s = 0
For i = 1 To endR - 1
  sTmp = Arr01(i, 1)
  If Not Dic.Exists(sTmp) Then
    s = s + 1
    Dic.Add sTmp, s
    Arr(s, 1) = sTmp
  End If
  k = Dic.Item(sTmp)
  If Arr(k, 2) = "" Or Arr(k, 2) > Arr02(i, 1) Then Arr(k, 2) = Arr02(i, 1) 'min
  If Arr(k, 3) < Arr02(i, 1) Then Arr(k, 3) = Arr02(i, 1) 'max
  Arr(k, 4) = (Arr(k, 2) + Arr(k, 3)) / 2
Next i
'Lay nhung dong thoa'
ReDim ArrKQ(1 To UBound(Arr), 1 To 1)
For i = 1 To UBound(Arr)
  sTmp = Arr01(i, 1)
  If Dic.Exists(sTmp) Then
    k = Dic.Item(sTmp)
    If Arr02(i, 1) = Arr(k, 2) Or Arr02(i, 1) = Arr(k, 3) Or Arr02(i, 1) = Arr(k, 4) Then
      ArrKQ(i, 1) = "x"
    End If
  End If
Next i
Sheets("Data").Select
Range("K2").Resize(i - 1, 1) = ArrKQ
Erase Arr01, Arr02, Arr, ArrKQ: Set Dic = Nothing
End Sub

Code này là học từ file TransferData của NDU về lấy max, min và TB.

 

[sontvxd10]

Cảm ơn bác đã bỏ chút thời gian quý báu để góp ý cho em. Code của bác chạy tốt lắm. Nhưng những hàm bác dùng thì lạ quá. Em mới gặp lần đầu. Để em cố hiểu xem ý nghĩa của nó xem. Tiện đây em cũng muốn hỏi thêm bác là. Với những khoảng mà nó có đến 4 giá trị TB mà em chỉ muốn lấy 2 giá trị ứng với 2 trị max và min của cột "I". Em có làm 1 đoạn Code dựa trên Code của bác concogia.

Private Sub CommandButton1_Click()
Rows("4:10000").Delete
Sheets("Du lieu goc").Range("A2:J10000").Copy
Sheets("Du lieu loc").Range("A4").Select
ActiveSheet.Paste
Dim Vung As Range, Wf, iMax, iMax2 As Double, iMin, iMin2 As Double, iMid As Double, VgDem, VgDem2 As Range, i As Long, Bd, Bd2 As Long, a As Long
Set Wf = Application.WorksheetFunction:  Set Vung = Range([a4], [a50000].End(xlUp))
    For i = 1 To Vung.Rows.Count
        If Vung(i) = Vung(i + 1) Then
               Bd = Wf.Match(Vung(i), Vung, 0) + 3
            Set VgDem = Cells(Bd, 1).Resize(Wf.CountIf(Vung, Vung(i))).Offset(, 2)
            iMax = Wf.max(VgDem): iMin = Wf.min(VgDem): iMid = Wf.Round((iMax + iMin) / 2, 5)
            Bd2 = Wf.Match(iMid, VgDem, 0) + 3
            Set VgDem2 = Cells(Bd2, 3).Resize(Wf.CountIf(VgDem, iMid)).Offset(, 6)
            iMax2 = Wf.max(VgDem2): iMin2 = Wf.min(VgDem2)
            If Vung(i).Offset(, 2) = iMid And Vung(i).Offset(, 8) = iMax2 Then Vung(i).Offset(, 10) = "*"
            If Vung(i).Offset(, 2) = iMid And Vung(i).Offset(, 8) = iMin2 Then Vung(i).Offset(, 10) = "*"
                If Vung(i).Offset(, 2) = iMax Or Vung(i).Offset(0, 2) = iMin Then Vung(i).Offset(, 10) = "*"
                a = a + 1
             Else
                    If Vung(i) = Vung(i - 1) And Vung(i) <> Vung(i + 1) Then Vung(i).Offset(, 10) = "*"
                     a = a + 1
        End If
Next
i = 4
    Do While Cells(i, "A") <> ""
        If Cells(i, "K") <> "*" Then
            Rows(i).Delete
        Else
            i = i + 1
        End If
    Loop
    Range("K:K").ClearContents
End Sub

Em cho chạy nhưng chỉ chạy đc trong 1 khoảng của cột "A" nhảy sang khoảng giá trị khác khác là nó báo lỗi liền. Mong ý kiến của các bác.

 

[sontvxd10]

Em hiểu nó sai ở đâu rồi. Là câu này:
Bd2 = Wf.Match(iMid, VgDem, 0) + 3
VgDem nó nhảy theo từng đoạn nên gias trị màm match đưa ra chỉ đúng với đoạn đầu là "B1" phải sửa lại thành
Bd2 = Wf.Match(iMid, VgDem, 0) + Bd - 1
Nhưng với đoạn 2 thì trị iMid lại không có trong đoạn VgDem nên hàm match bị lỗi. Bác nào có thể chỉ cho em cách khi gặp lỗi này thì cho nó nhảy qua nhận nhận trị max và min thôi không nhận trị TB nữa. Max và min đây là iMax và iMin ứng với cột "C"

 

[ThuNghi]

Em hiểu nó sai ở đâu rồi. Là câu này:
Bd2 = Wf.Match(iMid, VgDem, 0) + 3
VgDem nó nhảy theo từng đoạn nên gias trị màm match đưa ra chỉ đúng với đoạn đầu là "B1" phải sửa lại thành
Bd2 = Wf.Match(iMid, VgDem, 0) + Bd - 1
Nhưng với đoạn 2 thì trị iMid lại không có trong đoạn VgDem nên hàm match bị lỗi. Bác nào có thể chỉ cho em cách khi gặp lỗi này thì cho nó nhảy qua nhận nhận trị max và min thôi không nhận trị TB nữa. Max và min đây là iMax và iMin ứng với cột "C"

Dùng match trong câu

Bd2 = Wf.Match(iMid, VgDem, 0) + Bd - 1

=> dòng tìm thấy iMid
Nhưng nếu iMid không liên tục thì

Set VgDem2 = Cells(Bd2, 3).Resize(Wf.CountIf(VgDem, iMid)).Offset(, 6)

sẽ không được.
Nếu làm theo match và countif thì nên làm như sau có vẻ dễ hơn. Nên thêm biến solan=countif... cho dễ hình dung.
1/ Lấy danh mục duy nhất Beam (vungduynhat)
2/ Duyệt qua vungduynhat
- Dòng đầu (match)
- Solan (countif)
- Set VungDem
- Tính max, min, TB
3/ Duyệt qua VungDem, if VungDem(i) = iMid => xét min, max M3.
4/ Duyệt qua lại VungDem nếu M3=max or M3=min thì đánh dấu.
Phức tạp quá.
Bạn dùng thử code sau xem có OK không. Tôi làm theo hướng khác.

Option Explicit
Dim Dic As Object, sTmp As String
Dim endR As Long, i As Long, s As Long, k As Long
Dim Arr01, Arr02, Arr03, Arr, ArrKQ
Sub Danhdau()
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Data")
  endR = .Cells(65000, 1).End(xlUp).Row
  Arr01 = .Range("A2:A" & endR) 'Beam
  Arr02 = .Range("C2:C" & endR) 'Loc
  Arr03 = .Range("I2:I" & endR) 'M3
End With
ReDim Arr(1 To endR - 1, 1 To 6)
s = 0
For i = 1 To endR - 1
  sTmp = Arr01(i, 1)
  If Not Dic.Exists(sTmp) Then
    s = s + 1
    Dic.Add sTmp, s
    Arr(s, 1) = sTmp
  End If
  'Tao ra Arr ghi Min, Max, TB
  k = Dic.Item(sTmp)
  If Arr(k, 2) = "" Or Arr(k, 2) > Arr02(i, 1) Then Arr(k, 2) = Arr02(i, 1) 'min
  If Arr(k, 3) < Arr02(i, 1) Then Arr(k, 3) = Arr02(i, 1) 'max
  Arr(k, 4) = (Arr(k, 2) + Arr(k, 3)) / 2 'TB
Next i
'Duyet them 1 lan de lay Arr02=TB va Arr03 =max hay min
For i = 1 To UBound(Arr03)
  sTmp = Arr01(i, 1)
  If Dic.Exists(sTmp) Then
    k = Dic.Item(sTmp)
  End If
  If Arr02(i, 1) = Val(Arr(k, 4)) Then
    If Arr(k, 5) = "" Or Arr(k, 5) > Arr03(i, 1) Then Arr(k, 5) = Arr03(i, 1) 'min
    If Arr(k, 6) < Arr03(i, 1) Then Arr(k, 6) = Arr03(i, 1) 'max
  End If
Next i
'''Lay nhung dong thoa'
ReDim ArrKQ(1 To UBound(Arr02), 1 To 1)
For i = 1 To UBound(Arr02)
  sTmp = Arr01(i, 1)
  If Dic.Exists(sTmp) Then
    k = Dic.Item(sTmp)
    Select Case Arr02(i, 1)
      Case Val(Arr(k, 2))
        ArrKQ(i, 1) = "Min"
      Case Val(Arr(k, 3))
        ArrKQ(i, 1) = "Max"
      Case Val(Arr(k, 4))
        Select Case Arr03(i, 1)
          Case Val(Arr(k, 5))
            ArrKQ(i, 1) = "minTB"
          Case Val(Arr(k, 6))
            ArrKQ(i, 1) = "maxTB"
        End Select
      End Select
  End If
Next i
Sheets("Data").Select
With Range("K2").Resize(UBound(Arr02), 1)
  .ClearContents
  .Value = ArrKQ
End With
Erase Arr01, Arr02, Arr03, Arr, ArrKQ: Set Dic = Nothing
End Sub

 

[sontvxd10]

Code của bác OK rồi. Tiếc là em vẫn chưa dịch đc hết. Cái đối tượng "Object" này em ẫn chưa nắm đc. Để em viết lại theo hướng mà bác hướng dẫn xem sao. Có gì mong bác chỉ giáo thêm. Hy vọng 1 ngày nào đó đc giao lưu với bác. Em người xứ Quảng chắc khó mà gặp đc. Chúc bác và gia đình luôn mạnh khỏe.

 

[sontvxd10]

Ok rồi bác ơi. Theo sự chỉ dẫn của bác em chỉnh lại đc rồi.

Sub Danhdau()
[COLOR=#000000][COLOR=#0000BB][/COLOR][/COLOR]Dim Vung As Range, Wf, iMax, iMax2 As Double, iMin, iMin2 As Double, iMid As Double, VgDem, VgDem2 As Range, i As Long, Bd, Bd2 As Long, a, b As Long
Set Wf = Application.WorksheetFunction:  Set Vung = Range([a4], [a50000].End(xlUp))
b = 0
    For i = 1 To Vung.Rows.Count
        If Vung(i) = Vung(i + 1) Then
            Bd = Wf.Match(Vung(i), Vung, 0) + 3
            Set VgDem = Cells(Bd, 1).Resize(Wf.CountIf(Vung, Vung(i))).Offset(, 2)
            iMax = Wf.max(VgDem): iMin = Wf.min(VgDem): iMid = Wf.Round((iMax + iMin) / 2, 3)
            If Vung(i).Offset(, 2) = iMid Then
                Bd2 = Wf.Match(iMid, VgDem, 0) + Bd - 1
                Set VgDem2 = Cells(Bd2, 3).Resize(Wf.CountIf(VgDem, iMid)).Offset(, 6)
                iMax2 = Wf.max(VgDem2): iMin2 = Wf.min(VgDem2)
                    If Vung(i).Offset(, 2) = iMid And Vung(i).Offset(, 8) = iMax2 Then Vung(i).Offset(, 10) = "*"
                    If Vung(i).Offset(, 2) = iMid And Vung(i).Offset(, 8) = iMin2 Then Vung(i).Offset(, 10) = "*"
                Else
                    If Vung(i).Offset(, 2) = iMax Or Vung(i).Offset(0, 2) = iMin Then Vung(i).Offset(, 10) = "*"
                    If Vung(i).Offset(, 2) = iMax Or Vung(i).Offset(0, 2) = iMin Then Vung(i).Offset(, 10) = "*"
                    a = a + 1
                 End If
             Else
                    If Vung(i) = Vung(i - 1) And Vung(i) <> Vung(i + 1) Then Vung(i).Offset(, 10) = "*"
                     a = a + 1
                
        End If
Next i
EndSub

Lần nữa xin cảm ơn bác ThuNghi Và bác concogia.

 

[ThuNghi]

Code của bác OK rồi. Tiếc là em vẫn chưa dịch đc hết. Cái đối tượng "Object" này em ẫn chưa nắm đc. Để em viết lại theo hướng mà bác hướng dẫn xem sao. Có gì mong bác chỉ giáo thêm. Hy vọng 1 ngày nào đó đc giao lưu với bác. Em người xứ Quảng chắc khó mà gặp đc. Chúc bác và gia đình luôn mạnh khỏe.

Viết code theo hướng Match thì khó ở chỗ nếu MaxLoc và MinLoc sẽ có >1 lần ở cột Loc.
Tôi viết thử code theo hướng Match nhưng kết hợp thêm Find Methode. Với điều kiện LocTB xuất hiện liên tục. Còn không phải thêm 1 vòng lặp nữa để xác định M3 TB với LocTB.
Nghiên cứu thử xem. Có khi còn phức tạp hơn nghiên cứu Dictionary.

Option Explicit
Sub LocVung()
Dim rngBeam As Range, rngB As Range, rngLoc As Range, rngM As Range
Dim endR As Long, fR As Long, SoLan As Long, mR As Long, iMinLoc As Long, iMaxLoc As Long, iTbLoc As Long, iSL As Long, iL As Long, rTB As Long
Dim minLoc As Double, maxLoc As Double, tbLoc As Double, minTB As Double, maxTB As Double
Dim RngFound As Range
Dim Wf As WorksheetFunction
Set Wf = WorksheetFunction
With Sheets("Data")
  endR = .Cells(65000, 1).End(xlUp).Row
  Set rngBeam = .Range("A2:A" & endR) 'Beam
End With
Sheets("Data").Select
fR = 1: SoLan = 0
'MsgBox rngBeam.Count
Do While fR < rngBeam.Count + 1
  SoLan = Wf.CountIf(rngBeam, rngBeam(fR))
  Set rngB = rngBeam.Offset(fR - 1, 0).Resize(SoLan)
  Set rngLoc = rngB.Offset(, 2)
  'rngLoc.Select
  minLoc = Wf.min(rngLoc): maxLoc = Wf.max(rngLoc): tbLoc = Round((minLoc + maxLoc) / 2, 5)
  'Danh dau min
  iSL = Wf.CountIf(rngLoc, minLoc)
  Set RngFound = rngLoc(1)
  For iL = 1 To iSL
    Set RngFound = rngLoc.Find(What:=minLoc, After:=RngFound, SearchOrder:=xlColumns, LookIn:=xlValues, LookAt:=xlWhole)
      With RngFound
        .Offset(, 8) = "Min" 'Cot K
      End With
  Next iL
  'Danh dau max
  iSL = Wf.CountIf(rngLoc, maxLoc)
  Set RngFound = rngLoc(1)
  For iL = 1 To iSL
    Set RngFound = rngLoc.Find(What:=maxLoc, After:=RngFound, SearchOrder:=xlColumns, LookIn:=xlValues, LookAt:=xlWhole)
      With RngFound
        .Offset(, 8) = "Max" 'Cot K
      End With
  Next iL
  'Danh dau minTB, maxTB
  iSL = Wf.CountIf(rngLoc, tbLoc)
  If iSL > 0 Then
    rTB = Wf.Match(tbLoc, rngLoc, 0) - 1
    Set rngM = rngB.Offset(rTB, 8).Resize(iSL)
    rngM.Select
    minTB = Wf.min(rngM): maxTB = Wf.max(rngM)
    'danh dau minTB
    Set RngFound = rngM(1)
    Set RngFound = rngM.Find(What:=minTB, After:=RngFound, SearchOrder:=xlColumns, LookIn:=xlValues, LookAt:=xlWhole)
    With RngFound
      .Offset(, 2) = "MinTB" 'Cot K
    End With
    'danh dau maxTB
    Set RngFound = rngM(1)
    Set RngFound = rngM.Find(What:=maxTB, After:=RngFound, SearchOrder:=xlColumns, LookIn:=xlValues, LookAt:=xlWhole)
    With RngFound
      .Offset(, 2) = "MaxTB" 'Cot K
    End With
  End If
  fR = fR + SoLan
Loop
Set rngBeam = Nothing: Set rngB = Nothing: Set rngLoc = Nothing: Set rngM = Nothing
Set RngFound = Nothing: Set Wf = Nothing
End Sub

 

[sontvxd10]

Bác chỉ cho em hiểu nghĩa của câu lệnh này đc không?
Set RngFound = rngLoc.Find(What:=minLoc, After:=RngFound, SearchOrder:=xlColumns, LookIn:=xlValues, LookAt:=xlWhole)

 

[ThuNghi]

Bác chỉ cho em hiểu nghĩa của câu lệnh này đc không?
Set RngFound = rngLoc.Find(What:=minLoc, After:=RngFound, SearchOrder:=xlColumns, LookIn:=xlValues, LookAt:=xlWhole)

Với Find Methode.
RngFound dịch thoáng là range tìm thấy được qua câu lênh

Set RngFound = rngLoc.Find(What:=minLoc, After:=RngFound, SearchOrder:=xlColumns, LookIn:=xlValues, LookAt:=xlWhole)

1/ Tìm trong rngLoc rngLoc.Find
2/ Tìm minLoc What:=minLo
3/ Tìm sau dòng 1 của rngLoc After:=RngFound
4/ Tìm theo cột SearchOrder:=xlColumns
5/ Tìm giá trị LookIn:=xlValues
6/ Tìm chính xác. LookAt:=xlWhole
Nếu rngFound ie tìm thấy thì lấy cái gì thì lấy từ vị trí rngFound.
Bạn nên tìm về Find Methode trên GPE một thời là thế mạnh. Tìm bài của hoangdanh282vn hay SA_DQ...

 

[sontvxd10]

Set rngBeam = Nothing: Set rngB = Nothing: Set rngLoc = Nothing: Set rngM = Nothing
Set RngFound = Nothing: Set Wf = Nothing
Những câu này để giải phóng bộ nhớ thôi ah bác? Với cái Dictionary Object này em chưa hiểu gì cả.

 

[kicon]

Em muốn lấy dữ liệu cột thì như thế nào các Anh Chị...Ai biết chỉ dùm em...thanks nhiều