giúp em code lọc 3 giá trị Max Min1 Min2 (1 người xem)

[nad582]

khi bấm "LOC" thì nó sẽ Lọc 3 giá trị max min1 min2 của cột "L" tương ứng với tên phần tử của cột "A"
vấn đề là bấm chữ "Loc" thì nó lọc tại sheets (SteelBeam) luôn không lọc qua sheet khác...^^
mong các bạn giúp đỡ giùm em....cảm ơn nhiều!!

 

[concogia]

khi bấm "LOC" thì nó sẽ Lọc 3 giá trị max min1 min2 của cột "L" tương ứng với tên phần tử của cột "A"
vấn đề là bấm chữ "Loc" thì nó lọc tại sheets (SteelBeam) luôn không lọc qua sheet khác...^^
mong các bạn giúp đỡ giùm em....cảm ơn nhiều!!

Một cách viết:

Public Sub Loc()
    Dim Wf, d, Mg, Vung, VungDo, I, Max1, Min1, Min2, Gom, Tach
    Application.ScreenUpdating = False
    Set Wf = Application.WorksheetFunction
    Set d = CreateObject("scripting.dictionary")
    Set Vung = Range([A1], [A50000].End(xlUp))
        For I = 15 To Vung.Rows.Count
            If Not d.exists(Vung(I).Value) Then d.Add Vung(I).Value, ""
        Next I
            Mg = d.keys
            For I = 0 To UBound(Mg)
                Set VungDo = Cells(Wf.Match(Mg(I), Vung, 0), 1).Resize(Wf.CountIf(Vung, Mg(I)))
                    Max1 = VungDo(Wf.Match(Wf.Max(VungDo.Offset(, 11)), VungDo.Offset(, 11), 0)).Row
                    Min1 = VungDo(Wf.Match(Wf.Small(VungDo.Offset(, 11), 1), VungDo.Offset(, 11), 0)).Row
                    Min2 = VungDo(Wf.Match(Wf.Small(VungDo.Offset(, 11), 2), VungDo.Offset(, 11), 0)).Row
                    Gom = Gom & Max1 & " " & Min1 & " " & Min2 & " "
            Next I
     Range([A15], [A10000].End(xlUp)).EntireRow.Hidden = True
        Tach = Split(Gom)
        For I = 0 To UBound(Tach) - 1
            Rows(Val(Tach(I))).Hidden = False
        Next I
    Application.ScreenUpdating = True
End Sub

Để chung trong bảng thì mới cần format chữ đậm nhạt cho dễ nhìn chứ lọc riêng ra rồi thì cần quái gì đâm nhạt cho rách việc
Nếu có 2 thằng min thì tính sao ?????
Thân

 

[hungpecc1]

khi bấm "LOC" thì nó sẽ Lọc 3 giá trị max min1 min2 của cột "L" tương ứng với tên phần tử của cột "A"
vấn đề là bấm chữ "Loc" thì nó lọc tại sheets (SteelBeam) luôn không lọc qua sheet khác...^^
mong các bạn giúp đỡ giùm em....cảm ơn nhiều!!

Nhờ giúp đỡ thì bạn cũng phải có ít vốn VBA chứ !
Cuối giờ rồi,đang vội về nên viết nháp 1 đoạn code để bạn tham khảo --> bạn tự ngâm cứu chỉnh sửa cho phù hợp với ý đồ của mình
[GPECODE=vb]
Sub GPE()
Dim tmparr, tmp, item, Arr
Dim n As Long, i As Long, k As Long, Fr As String
Dim Drp As DropDown
ActiveSheet.AutoFilterMode = False
Set Drp = ActiveSheet.DropDowns("Drop Down 2")
tmparr = Range("A14", [L65536].End(3))
ReDim Arr(1 To UBound(tmparr, 1), 1 To 5)
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tmparr, 1)
item = tmparr(i, 1)
If Len(item) Then
tmp = Trim(CStr(item))
If Not .exists(tmp) Then
n = n + 1
.Add tmp, n
Arr(n, 1) = tmp: Arr(n, 2) = tmparr(i, 12)
Arr(n, 3) = Arr(n, 2): Arr(n, 4) = 0
Arr(n, 5) = CDbl(tmparr(i, 2))
Else
k = .item(tmp)
If tmparr(i, 12) > Arr(k, 2) Then
Arr(k, 2) = tmparr(i, 12)
ElseIf tmparr(i, 12) < Arr(k, 3) And CDbl(tmparr(i, 2)) = Arr(k, 5) Then
Arr(k, 3) = tmparr(i, 12)
ElseIf tmparr(i, 12) < Arr(k, 4) And CDbl(tmparr(i, 2)) <> Arr(k, 5) Then
Arr(k, 4) = tmparr(i, 12)

End If
End If
End If
Next
Fr = Trim(CStr(Drp.List(Drp.Value)))
[IU1] = [A12]: [IV1] = [L12]: [IV2] = [L13]
[IU3] = Fr
[IV3] = Arr(.item(Fr), 2): [IV4] = Arr(.item(Fr), 3): [IV5] = Arr(.item(Fr), 4)
End With
Range("A12:R10000").AdvancedFilter 1, [IU1:IV5], , 1
[IU1:IV5].Clear
End Sub
[/GPECODE]

 

[vodoi2x]

xem tại đây
http://www.giaiphapexcel.com/forum/...copy-công-thức-xuống-dòng&p=489234#post489234

 

[nad582]

Nhờ giúp đỡ thì bạn cũng phải có ít vốn VBA chứ !
Cuối giờ rồi,đang vội về nên viết nháp 1 đoạn code để bạn tham khảo --> bạn tự ngâm cứu chỉnh sửa cho phù hợp với ý đồ của mình

[/GPECODE]

mình mới tập học VBA ak, đang tìm lóp học...mong bạn chỉ dẫn...mình có 2 vấn đề:
câu1: mình có đoạn code trong file nhưng sử dụng nó lọc cũng được nhưng nhiều tên ở cột A nó lọc thiếu ko đử 3 tiết diện Max Min1 Min2 như mình muốn, bạn xem rồi sửa lại cho mình với..cảm ơn nhiều...
câu 2: là câu hỏi trong file lun bạn...
mong bạn giúp giùm mình...

 

[hungpecc1]

mình mới tập học VBA ak, đang tìm lóp học...mong bạn chỉ dẫn...mình có 2 vấn đề:
câu1: mình có đoạn code trong file nhưng sử dụng nó lọc cũng được nhưng nhiều tên ở cột A nó lọc thiếu ko đử 3 tiết diện Max Min1 Min2 như mình muốn, bạn xem rồi sửa lại cho mình với..cảm ơn nhiều...
câu 2: là câu hỏi trong file lun bạn...
mong bạn giúp giùm mình...

[WARNING1]Chú ý : không được post 2 bài trên diễn đàn cùng 1 nội dung --> vi pham nội quy[/WARNING1]
Mới học bạn record macro là có code ngay mà --> ví dụ tôi record macro sau :
[GPECODE=vb]Sub Macro1()
Dim Tmparr, item, Arr(1 To 3), Ir()
Dim n As Long, i As Long, j As Long
Dim rng As Range
Application.ScreenUpdating = False
With ActiveSheet
.AutoFilterMode = 0
Tmparr = .Range(.[A14], .[A65536].End(3))
ReDim Ir(1 To UBound(Tmparr, 1))
End With
For i = 1 To UBound(Tmparr, 1) - 1
For j = i + 1 To UBound(Tmparr, 1)
If Not Tmparr(j, 1) Like Tmparr(i, 1) Then Exit For
Next
Set rng = Range("L" & i + 13 & "", "L" & j + 12 & "")
With WorksheetFunction
Arr(1) = .Max(rng): Arr(2) = .Min(rng): Arr(3) = .Small(rng, 2)
For Each item In Arr
n = n + 1
Ir(n) = .Match(item, [L14:L10000], 0)
Next
End With
i = j - 1
Next
Range("A14", [A65536].End(3)).EntireRow.Hidden = True
For i = 1 To n
Range("A" & Ir(i) + 13 & "").EntireRow.Hidden = False
Next
Application.ScreenUpdating = True
End Sub[/GPECODE]
** Mà không có khái niệm Max, Min1, Min2 đâu nhé : đây là momen giữa dầm và 2 đầu dầm <--- bạn phải giải thích cụ thể hơn
** Cái này là đồ án thì phải --> vì tôi thấy đi làm ít người dùng kiểu này
** Sao không tính lệch tâm xiên, lại tính lệch tâm phẳng ?
Xem file đính kèm :

 

[nad582]

[WARNING1]Chú ý : không được post 2 bài trên diễn đàn cùng 1 nội dung --> vi pham nội quy[/WARNING1]
Mới học bạn record macro là có code ngay mà --> ví dụ tôi record macro sau :
[GPECODE=vb]Sub Macro1()
Dim Tmparr, item, Arr(1 To 3), Ir()
Dim n As Long, i As Long, j As Long
Dim rng As Range
Application.ScreenUpdating = False
With ActiveSheet
.AutoFilterMode = 0
Tmparr = .Range(.[A14], .[A65536].End(3))
ReDim Ir(1 To UBound(Tmparr, 1))
End With
For i = 1 To UBound(Tmparr, 1) - 1
For j = i + 1 To UBound(Tmparr, 1)
If Not Tmparr(j, 1) Like Tmparr(i, 1) Then Exit For
Next
Set rng = Range("L" & i + 13 & "", "L" & j + 12 & "")
With WorksheetFunction
Arr(1) = .Max(rng): Arr(2) = .Min(rng): Arr(3) = .Small(rng, 2)
For Each item In Arr
n = n + 1
Ir(n) = .Match(item, [L14:L10000], 0)
Next
End With
i = j - 1
Next
Range("A14", [A65536].End(3)).EntireRow.Hidden = True
For i = 1 To n
Range("A" & Ir(i) + 13 & "").EntireRow.Hidden = False
Next
Application.ScreenUpdating = True
End Sub[/GPECODE]
** Mà không có khái niệm Max, Min1, Min2 đâu nhé : đây là momen giữa dầm và 2 đầu dầm <--- bạn phải giải thích cụ thể hơn
** Cái này là đồ án thì phải --> vì tôi thấy đi làm ít người dùng kiểu này
** Sao không tính lệch tâm xiên, lại tính lệch tâm phẳng ?
Xem file đính kèm :

mình dựa vào code của các bạn (lọc 3 tiết diện dầm) làm thử cái file này mak ko được, nó bị lỗi...
các bạn xem sữa giùm mình với...cảm ơn nhiều...