Nhờ giúp đỡ code VBA hàm max

hml89 · 13/9/18

Xin chào tất cả anh/chị trong diễn đàn.
Tôi có đang thực hành làm hàm min và max . Tôi đã làm xong được hàm min, nhưng không biết làm sao để lồng thêm hàm max vào nữa.
Ngoài ra thì có thêm 2 cột nữa (E&F) cũng muốn làm tương tự. Tôi đang nghĩ đến trường hợp là phải viết 4 sub, nhưng nhu thế thì hơi thủ công nên muốn nhờ mọi người hướng dẫn.
(tôi đang thực hành việc sử dụng code cho trường hợp này thôi nhé)
Xin cám ơn

khi ta 20 · 13/9/18

hml89 đã viết:
Xin chào tất cả anh/chị trong diễn đàn.
Tôi có đang thực hành làm hàm min và max . Tôi đã làm xong được hàm min, nhưng không biết làm sao để lồng thêm hàm max vào nữa.
Ngoài ra thì có thêm 2 cột nữa (E&F) cũng muốn làm tương tự. Tôi đang nghĩ đến trường hợp là phải viết 4 sub, nhưng nhu thế thì hơi thủ công nên muốn nhờ mọi người hướng dẫn.
(tôi đang thực hành việc sử dụng code cho trường hợp này thôi nhé)
Xin cám ơn

Bạn xem thử nha
Chết rồi ,gởi xong mới thấy chữ "VBA"

hml89 · 13/9/18

khi ta 20 đã viết:
Bạn xem thử nha
Chết rồi ,gởi xong mới thấy chữ "VBA"

VetMini · 13/9/18

hml89 đã viết:
...
(tôi đang thực hành việc sử dụng code cho trường hợp này thôi nhé)
Xin cám ơn

Thực hành hay là thực tập?

hml89 · 13/9/18

VetMini đã viết:
Thực hành hay là thực tập?

Thưa bác là cả 2 nhé, không "tập hành" thì không nhớ được . Bác giúp tôi đi!

SA_DQ · 13/9/18

PHP:

Sub XacDinhCucTriDuLieuNgay_Thang_Nam()
 Dim WF As Object, CSDL As Range, Cls As Range
 Dim Rws As Long, Col As Byte
 
 Set WF = Application.WorksheetFunction
 Rws = [B1].CurrentRegion.Rows.Count
 Set CSDL = [A1].Resize(Rws, 6)
 [M1].Value = [A1].Value
 For Each Cls In Range([g2], [g2].End(xlDown))
    [M2].Value = Cls.Value
    Cls.Offset(, 1).Value = WF.DMin(CSDL, [C1], [M1:M2])
    Cls.Offset(, 2).Value = WF.DMax(CSDL, [D1], [M1:M2])
    Cls.Offset(, 3).Value = WF.DMin(CSDL, [e1], [M1:M2])
    Cls.Offset(, 4).Value = WF.DMax(CSDL, [F1], [M1:M2])
 Next Cls
 [M1:M2].Clear
End Sub

VetMini · 13/9/18

Có thấy cái hàm minh mắc ở chỗ nào đâu mà tập với tành, hành với hạ.

hml89 · 13/9/18

VetMini đã viết:
Có thấy cái hàm minh mắc ở chỗ nào đâu mà tập với tành, hành với hạ.

Có mà, ở trong code có cái WorksheetFunction.Min đó

Bài đã được tự động gộp: 13/9/18

SA_DQ đã viết:

PHP:

Sub XacDinhCucTriDuLieuNgay_Thang_Nam()
Dim WF As Object, CSDL As Range, Cls As Range
Dim Rws As Long, Col As Byte

Set WF = Application.WorksheetFunction
Rws = [B1].CurrentRegion.Rows.Count
Set CSDL = [A1].Resize(Rws, 6)
[M1].Value = [A1].Value
For Each Cls In Range([g2], [g2].End(xlDown))
    [M2].Value = Cls.Value
    Cls.Offset(, 1).Value = WF.DMin(CSDL, [C1], [M1:M2])
    Cls.Offset(, 2).Value = WF.DMax(CSDL, [D1], [M1:M2])
    Cls.Offset(, 3).Value = WF.DMin(CSDL, [e1], [M1:M2])
    Cls.Offset(, 4).Value = WF.DMax(CSDL, [F1], [M1:M2])
Next Cls
[M1:M2].Clear
End Sub

Cám ơn bác SA_DQ , code của bác hay và ngắn gọn quá! so với cách của bác thì code của tôi như trẻ thơ tập bò vậy đó!
Bác cho tôi hỏi một chút là có phải nếu làm theo cách của tôi thì phải viết tận 4sub lận không?

hml89 · 13/9/18

SA_DQ đã viết:

PHP:

Sub XacDinhCucTriDuLieuNgay_Thang_Nam()
Dim WF As Object, CSDL As Range, Cls As Range
Dim Rws As Long, Col As Byte

Set WF = Application.WorksheetFunction
Rws = [B1].CurrentRegion.Rows.Count
Set CSDL = [A1].Resize(Rws, 6)
[M1].Value = [A1].Value
For Each Cls In Range([g2], [g2].End(xlDown))
    [M2].Value = Cls.Value
    Cls.Offset(, 1).Value = WF.DMin(CSDL, [C1], [M1:M2])
    Cls.Offset(, 2).Value = WF.DMax(CSDL, [D1], [M1:M2])
    Cls.Offset(, 3).Value = WF.DMin(CSDL, [e1], [M1:M2])
    Cls.Offset(, 4).Value = WF.DMax(CSDL, [F1], [M1:M2])
Next Cls
[M1:M2].Clear
End Sub

Bác SA_DQ ơi, khi mà xóa mã nhóm đi thì nó chạy như thế này đây, mà nó còn bị đơ máy luôn. Bác xem giúp tôi với

SA_DQ · 13/9/18

Thế thì tra "từ điển VBA" để hiểu hết các câu lệnh trong macro đi đã.

quanluu · 13/9/18

Cũng biết bạn đang tập tành code nhưng chia sẻ thêm cho bạn 1 code

Mã:

Sub minmax()
    Dim cn As Object
    Set cn = CreateObject("ADODB.Connection")
    cn.Open ("Provider=Microsoft.ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;IMEX=1"";")
    Range("G2").CopyFromRecordset cn.Execute("select f1, min(f3), max(f4), min(f5), max(f6) from [A2:F] group by f1")
    Set cn = Nothing
End Sub

SA_DQ · 13/9/18

Cám ơn bác , code của bác hay và ngắn gọn quá!(1) so với cách của bác thì code của tôi như trẻ thơ tập bò vậy đó!
(2) Bác cho tôi hỏi một chút là có phải nếu làm theo cách của tôi thì phải viết tận 4sub lận không?

(1) Code của mình cho người bình dân học vụ mà!
Macro của bạn rất hàn lâm nữa là đằng khác!
Nhưng câu lệnh này chưa thật chặt chẽ:

Mã:

For Each Cll In Range("A2:A100")

(2) Chắc là không đâu bạn!

hml89 · 14/9/18

SA_DQ đã viết:
(1) Code của mình cho người bình dân học vụ mà!
Macro của bạn rất hàn lâm nữa là đằng khác!
Nhưng câu lệnh này chưa thật chặt chẽ:

Mã:

For Each Cll In Range("A2:A100")

(2) Chắc là không đâu bạn!

Xin chào bạn SA_DQ, trước tiên tôi xin cám ơn bạn đã hướng dẫn cho tôi. Sau là bạn có thể giúp tôi cái vấn đề là nếu làm theo cách của tôi thì làm như thế nào để không phải viết 4sub.
Cám ơn bạn, chúc bạn ngày mới vui vẻ!

quanluu · 14/9/18

hml89 đã viết:
Xin chào bạn SA_DQ, trước tiên tôi xin cám ơn bạn đã hướng dẫn cho tôi. Sau là bạn có thể giúp tôi cái vấn đề là nếu làm theo cách của tôi thì làm như thế nào để không phải viết 4sub.
Cám ơn bạn, chúc bạn ngày mới vui vẻ!

Không phải viết 4 sub thì bạn viết 4 lần code trong 1 sub thôi, còn vấn đề của bạn kết hợp dic và mảng là được.

Mã:

Sub tonghop2()
Dim Mydic As New Dictionary, kq(1 To 100, 1 To 5), k, indx
Dim cll As Range
For Each cll In Range("A2:A100")
    If Not Mydic.Exists(cll.Value) Then
        k = k + 1
        Mydic.Add cll.Value, k
        kq(k, 1) = cll.Value
        kq(k, 2) = cll.Offset(, 2).Value
        kq(k, 3) = cll.Offset(, 3).Value
        kq(k, 4) = cll.Offset(, 4).Value
        kq(k, 5) = cll.Offset(, 5).Value
    Else
        indx = Mydic.Item(cll.Value)
        'min
        If kq(indx, 2) > cll.Offset(, 2).Value Then kq(k, 2) = cll.Offset(, 2).Value
        If kq(indx, 4) > cll.Offset(, 4).Value Then kq(k, 4) = cll.Offset(, 4).Value
        'max
        If kq(indx, 3) < cll.Offset(, 3).Value Then kq(k, 3) = cll.Offset(, 3).Value
        If kq(indx, 5) < cll.Offset(, 5).Value Then kq(k, 5) = cll.Offset(, 5).Value
    End If
Next
If k Then Range("G2").Resize(k, 5) = kq
End Sub

ndu96081631 · 14/9/18

hml89 đã viết:
Tôi có đang thực hành làm hàm min và max

Cái này là bạn viết chơi chơi để học VBA hay viết để dùng thiệt? Hỏi vậy là vì:
- Nếu viết chơi chơi để học VBA thì.. cứ viết
- Nếu viết để dùng thiệt, tôi khuyên bạn đừng vì mức độ phức tạp của bài toán và mặc khác anh Bill đã viết sẵn cho bạn cái PivotTable rồi, cứ vậy mà dùng, không cần làm thêm gì nữa cả (có làm cũng dở hơn người ta)

hml89 · 14/9/18

ndu96081631 đã viết:
Cái này là bạn viết chơi chơi để học VBA hay viết để dùng thiệt? Hỏi vậy là vì:
- Nếu viết chơi chơi để học VBA thì.. cứ viết
- Nếu viết để dùng thiệt, tôi khuyên bạn đừng vì mức độ phức tạp của bài toán và mặc khác anh Bill đã viết sẵn cho bạn cái PivotTable rồi, cứ vậy mà dùng, không cần làm thêm gì nữa cả (có làm cũng dở hơn người ta)

Thưa anh ndu96081631, cái này em dùng để học anh ạ, còn thực tế em có xử lý bằng pivot table rồi. Nhưng em đang làm bằng VBA thì nó bị vướng mắc ở chỗ là ko biết nếu làm ra bảng tổng hợp vậy thì làm như thế nào nên có mang lên diễn đàn để hỏi ạ.
Em cũng biết là rất dở hơi, mong các anh/chị thông cảm ạ!

Bài đã được tự động gộp: 14/9/18

quanluu1989 đã viết:

Không phải viết 4 sub thì bạn viết 4 lần code trong 1 sub thôi, còn vấn đề của bạn kết hợp dic và mảng là được.

Mã:

Sub tonghop2()
Dim Mydic As New Dictionary, kq(1 To 100, 1 To 5), k, indx
Dim cll As Range
For Each cll In Range("A2:A100")
    If Not Mydic.Exists(cll.Value) Then
        k = k + 1
        Mydic.Add cll.Value, k
        kq(k, 1) = cll.Value
        kq(k, 2) = cll.Offset(, 2).Value
        kq(k, 3) = cll.Offset(, 3).Value
        kq(k, 4) = cll.Offset(, 4).Value
        kq(k, 5) = cll.Offset(, 5).Value
    Else
        indx = Mydic.Item(cll.Value)
        'min
        If kq(indx, 2) > cll.Offset(, 2).Value Then kq(k, 2) = cll.Offset(, 2).Value
        If kq(indx, 4) > cll.Offset(, 4).Value Then kq(k, 4) = cll.Offset(, 4).Value
        'max
        If kq(indx, 3) < cll.Offset(, 3).Value Then kq(k, 3) = cll.Offset(, 3).Value
        If kq(indx, 5) < cll.Offset(, 5).Value Then kq(k, 5) = cll.Offset(, 5).Value
    End If
Next
If k Then Range("G2").Resize(k, 5) = kq
End Sub

Cám ơn quanluu1989 nhé!

Ba Tê · 14/9/18

hml89 đã viết:
Sau là bạn có thể giúp tôi cái vấn đề là nếu làm theo cách của tôi thì làm như thế nào để không phải viết 4sub.

Một Sub, Cột H:K format trước kiểu "d/m" giống như cột C:F

PHP:

Public Sub Gpe()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, eRw As Long, Rw As Long, Txt As String
sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 6).Value
eRw = UBound(sArr)
ReDim dArr(1 To eRw, 1 To 5)
With CreateObject("Scripting.Dictionary")
    For I = 1 To eRw
        Txt = sArr(I, 1)
        If Not .Exists(Txt) Then
            K = K + 1
            .Item(Txt) = K
            dArr(K, 1) = Txt
            For J = 2 To 5
                dArr(K, J) = sArr(I, J + 1)
            Next J
        Else
            Rw = .Item(Txt)
            If sArr(I, 3) < dArr(Rw, 2) Then dArr(Rw, 2) = sArr(I, 3)
            If sArr(I, 4) > dArr(Rw, 3) Then dArr(Rw, 3) = sArr(I, 4)
            If sArr(I, 5) < dArr(Rw, 4) Then dArr(Rw, 4) = sArr(I, 5)
            If sArr(I, 6) > dArr(Rw, 5) Then dArr(Rw, 5) = sArr(I, 6)
        End If
    Next I
End With
Range("G2").Resize(K, 5) = dArr
End Sub

hml89 · 14/9/18

Ba Tê đã viết:

Một Sub, Cột H:K format trước kiểu "d/m" giống như cột C:F

PHP:

Public Sub Gpe()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, eRw As Long, Rw As Long, Txt As String
sArr = Range("A2", Range("A2").End(xlDown)).Resize(, 6).Value
eRw = UBound(sArr)
ReDim dArr(1 To eRw, 1 To 5)
With CreateObject("Scripting.Dictionary")
    For I = 1 To eRw
        Txt = sArr(I, 1)
        If Not .Exists(Txt) Then
            K = K + 1
            .Item(Txt) = K
            dArr(K, 1) = Txt
            For J = 2 To 5
                dArr(K, J) = sArr(I, J + 1)
            Next J
        Else
            Rw = .Item(Txt)
            If sArr(I, 3) < dArr(Rw, 2) Then dArr(Rw, 2) = sArr(I, 3)
            If sArr(I, 4) > dArr(Rw, 3) Then dArr(Rw, 3) = sArr(I, 4)
            If sArr(I, 5) < dArr(Rw, 4) Then dArr(Rw, 4) = sArr(I, 5)
            If sArr(I, 6) > dArr(Rw, 5) Then dArr(Rw, 5) = sArr(I, 6)
        End If
    Next I
End With
Range("G2").Resize(K, 5) = dArr
End Sub

Em cám ơn anh Ba Tê . Chúc anh ngày mới vui vẻ!

Nhờ giúp đỡ code VBA hàm max

Thành viên tiêu biểu

File đính kèm

Thành viên thường trực

File đính kèm

Thành viên tiêu biểu

Ăn cùng góc phố

Thành viên tiêu biểu

/(hông là gì!

Ăn cùng góc phố

Thành viên tiêu biểu

Thành viên tiêu biểu

/(hông là gì!

Thành viên gắn bó

/(hông là gì!

Thành viên tiêu biểu

Thành viên gắn bó

Huyền thoại GPE

Thành viên tiêu biểu

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

Thành viên tiêu biểu

Đếm ngược thời gian