Tìm giá trị nhỏ nhất của từng năm (2 người xem)

anhtb82 · 15/6/18

Xin chào mọi người, mình có bài tập như sau muốn mọi người chỉ giúp code VBA cho bài này.
* Bài tập: Tìm ra giá trị Số lượng nhỏ nhất của mỗi năm (có thể có rất nhiều năm khác nhau nhưng đây mình chỉ lấy ví dụ một số), sau đó điền giá trị Nhỏ nhất tìm được vào những ô BÔI VÀNG.
- Minh họa kết quả như hình dưới đây:
Mong mọi người giúp đỡ.

phulien1902 · 15/6/18

anhtb82 đã viết:
Xin chào mọi người, mình có bài tập như sau muốn mọi người chỉ giúp code VBA cho bài này.
* Bài tập: Tìm ra giá trị Số lượng nhỏ nhất của mỗi năm (có thể có rất nhiều năm khác nhau nhưng đây mình chỉ lấy ví dụ một số), sau đó điền giá trị Nhỏ nhất tìm được vào những ô BÔI VÀNG.
- Minh họa kết quả như hình dưới đây:
Mong mọi người giúp đỡ.
View attachment 197499

Bạn muốn có kết quả như hình dưới không? Chỉ cần vài giây là có

anhtb82 · 15/6/18

phulien1902 đã viết:
Bạn muốn có kết quả như hình dưới không? Chỉ cần vài giây là có
View attachment 197500

cảm ơn bạn, bạn có thể chỉ giúp mình với nhưng mình cũng đang muốn tìm 1 cách cho ra kết quả như đúng hình mình minh họa bên trên

phulien1902 · 15/6/18

anhtb82 đã viết:
cảm ơn bạn, bạn có thể chỉ giúp mình với nhưng mình cũng đang muốn tìm 1 cách cho ra kết quả như đúng hình mình minh họa bên trên

Bạn dùng công cụ sẵn có trong Excel, đó là Consolidate

ndu96081631 · 15/6/18

anhtb82 đã viết:
cảm ơn bạn, bạn có thể chỉ giúp mình với nhưng mình cũng đang muốn tìm 1 cách cho ra kết quả như đúng hình mình minh họa bên trên

Thử code tào lao này:

Mã:

Sub Test()
  Dim rng As Range, aRes
  Dim lRow As Long, lYear
  Dim ret
  Dim strFormula As String
  Set rng = Range("A2:A21")
  aRes = rng.Value
  For lRow = 1 To UBound(aRes, 1)
    If aRes(lRow, 1) <> lYear Then
      lYear = aRes(lRow, 1)
      strFormula = "MIN(IF(" & rng.Address & "=" & lYear & ", " & rng.Offset(, 1).Address & ", """"))"
      ret = Evaluate(strFormula)
    End If
    aRes(lRow, 1) = ret
  Next
  rng.Offset(, 2).Value = aRes
End Sub

SA_DQ · 15/6/18

Có thể xài DMIN() trong macro để tìm

anhtb82 · 15/6/18

ndu96081631 đã viết:

Thử code tào lao này:

Mã:

Sub Test()
  Dim rng As Range, aRes
  Dim lRow As Long, lYear
  Dim ret
  Dim strFormula As String
  Set rng = Range("A2:A21")
  aRes = rng.Value
  For lRow = 1 To UBound(aRes, 1)
    If aRes(lRow, 1) <> lYear Then
      lYear = aRes(lRow, 1)
      strFormula = "MIN(IF(" & rng.Address & "=" & lYear & ", " & rng.Offset(, 1).Address & ", """"))"
      ret = Evaluate(strFormula)
    End If
    aRes(lRow, 1) = ret
  Next
  rng.Offset(, 2).Value = aRes
End Sub

Rất cảm ơn code "tào lao" của cao thủ, nhưng em rất muốn đc thêm chú thích để hiểu rõ nội dung dòng code ạ. Vì em hay hỏi các ví dụ để sau này ứng dụng vào một số bài toán có những yêu cầu tương tự như thế ^^.
Cảm ơn bác!

SA_DQ · 15/6/18

Còn code này dễ hiểu hơn nè:

PHP:

Sub TimMINTheoNam()
Dim WF As Object, CSDL As Range, sRng As Range
Dim Rws As Long, Nho As Integer, Lon As Integer, J As Long
Set WF = Application.WorksheetFunction

Rws = [A2].CurrentRegion.Rows.Count
Set CSDL = [A1].Resize(Rws, 2)
Nho = WF.Min(CSDL(1).Resize(Rws))
Lon = WF.Max(CSDL(1).Resize(Rws))
[e1].Value = [A1].Value
For J = Nho To Lon
    Set sRng = CSDL(1).Resize(Rws).Find(J, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        [E2].Value = J
        sRng.Offset(, 2).Value = WF.DMin(CSDL, [B1], [E1:E2])
    End If
Next J
[E1:E2].Value = Space(0)
End Sub

phulien1902 · 15/6/18

Thêm 1 cách:

PHP:

Sub abc() 
    With Sheet1.Range("C2:C21")
        .Cells(1).FormulaArray = "=IF(MIN(IF($A$2:$A$21=$A2,$B$2:$B$21))=B2,B2,"""")"
        .FillDown
        .Value = .Value
        .SpecialCells(4).FormulaR1C1 = "=R[-1]C"
    End With
End Sub

Lê Hồng Minh83 · 15/6/18

anhtb82 đã viết:
Xin chào mọi người, mình có bài tập như sau muốn mọi người chỉ giúp code VBA cho bài này.
* Bài tập: Tìm ra giá trị Số lượng nhỏ nhất của mỗi năm (có thể có rất nhiều năm khác nhau nhưng đây mình chỉ lấy ví dụ một số), sau đó điền giá trị Nhỏ nhất tìm được vào những ô BÔI VÀNG.
- Minh họa kết quả như hình dưới đây:
Mong mọi người giúp đỡ.
View attachment 197499

Thêm 1 cách khác
Nếu dữ liệu bên cột B là tăng dần
Tại ô C2=VLOOKUP(A2,$A$2:$B$21,2,0)
Quăng bài hàm vào lập trình, ngại quá,

phulien1902 · 15/6/18

Lê Hồng Minh83 đã viết:
Thêm 1 cách khác
Nếu dữ liệu bên cột B là tăng dần
Tại ô C2=VLOOKUP(A2,$A$2:$B$21,2,0)

Cách này mạo hiểm quá( nguy hiểm quá), khà khà.

Lê Hồng Minh83 · 15/6/18

phulien1902 đã viết:
Cách này mạo hiểm quá( nguy hiểm quá), khà khà.

Có hướng dẫn sử dụng trước khi dùng, khà khà khà

ngoctinh87 · 15/6/18

anhtb82 đã viết:
Xin chào mọi người, mình có bài tập như sau muốn mọi người chỉ giúp code VBA cho bài này.
* Bài tập: Tìm ra giá trị Số lượng nhỏ nhất của mỗi năm (có thể có rất nhiều năm khác nhau nhưng đây mình chỉ lấy ví dụ một số), sau đó điền giá trị Nhỏ nhất tìm được vào những ô BÔI VÀNG.
- Minh họa kết quả như hình dưới đây:
Mong mọi người giúp đỡ.
View attachment 197499

Bạn có thể dùng công thức hoặc PivotTable

anhtb82 · 16/6/18

ndu96081631 đã viết:

Thử code tào lao này:

Mã:

Sub Test()
  Dim rng As Range, aRes
  Dim lRow As Long, lYear
  Dim ret
  Dim strFormula As String
  Set rng = Range("A2:A21")
  aRes = rng.Value
  For lRow = 1 To UBound(aRes, 1)
    If aRes(lRow, 1) <> lYear Then
      lYear = aRes(lRow, 1)
      strFormula = "MIN(IF(" & rng.Address & "=" & lYear & ", " & rng.Offset(, 1).Address & ", """"))"
      ret = Evaluate(strFormula)
    End If
    aRes(lRow, 1) = ret
  Next
  rng.Offset(, 2).Value = aRes
End Sub

Dear bác,

Bác có thể áp dụng cụ thể vào bài tập file đính kèm giúp em được k ạ, nhưng bài tập này có thêm một số điều kiện
Yêu cầu cũng là tìm giá trị nhỏ nhất và điền vào cột bôi vàng nhưng với điều kiện,
- Nếu giá trị tại ô F1 của Sheet "Canlendar" nằm trong khoảng được tô màu Xanh thì tìm giá trị nhỏ nhất của từng "fixed suppiler" theo giá trị của cột C (Date) nằm trong khoảng tô màu Xanh
- Nếu giá trị tại ô F1 của Sheet "Canlendar" nằm trong khoảng được tô màu Cam thì tìm giá trị nhỏ nhất của từng "fixed suppiler" theo giá trị của cột C (Date) nằm trong khoảng tô màu Xanh và tô màu Cam
* Các giá trị của khoảng tô màu này là cố định vị trí nên bác có thể gán giá trị theo Cell hay Range tùy ý vì sau này em sẽ phải thay đổi theo từng thời gian khác nữa.
* Nếu giá trị F1 nằm trong khoảng màu Xanh thì nếu giá trị tại cột "Date" nằm trong khoảng Vàng và Cam thì tại hàng I sẽ điền xóa,
* Nếu giá trị F1 nằm trong khoảng màu Cam thì nếu giá trị tại cột "Date" nằm trong khoảng Vàng thì tại hàng I sẽ điền xóa,
=> Để dễ hình dung mình đã biểu thị kết quả cuối cùng như file đính kèm đây.
Mong được sự giúp đỡ của bác cũng như mọi người!
Thanks!

befaint · 16/6/18

Sau 13 bài thì mới bắt đầu khởi động.

@ Chủ thớt: Xem kĩ lại lần cuối còn thiếu gì bổ sung hết một lượt đi.

VetMini · 16/6/18

befaint đã viết:
Sau 13 bài thì mới bắt đầu khởi động.

Ngừoi ta đợi nhiều bài để có chỗ so sánh lấy cái "chiến" nhất chứ. Nếu không thì phụ lòng sốt sắng của các bạn sao?

befaint đã viết:
@ Chủ thớt: Xem kĩ lại lần cuối còn thiếu gì bổ sung hết một lượt đi.

Chưa có đáp án của điều 1 thì làm sao biết nó còn lòi ra điều 2. Không làm vậy phụ lòng kiên nhẫn của quý vị sao?

anhtb82 · 18/6/18

befaint đã viết:
Sau 13 bài thì mới bắt đầu khởi động.

@ Chủ thớt: Xem kĩ lại lần cuối còn thiếu gì bổ sung hết một lượt đi.

về cơ bản mình muốn kiểu code như của bác NDU để tự áp dụng vào bài của mình nhưng code bác ấy mình k hiều 1 số chỗ nên k biết áp dụng vào bài mình ntn ^^

anhtb82 · 18/6/18

SA_DQ đã viết:

Còn code này dễ hiểu hơn nè:

PHP:

Sub TimMINTheoNam()
Dim WF As Object, CSDL As Range, sRng As Range
Dim Rws As Long, Nho As Integer, Lon As Integer, J As Long
Set WF = Application.WorksheetFunction

Rws = [A2].CurrentRegion.Rows.Count
Set CSDL = [A1].Resize(Rws, 2)
Nho = WF.Min(CSDL(1).Resize(Rws))
Lon = WF.Max(CSDL(1).Resize(Rws))
[e1].Value = [A1].Value
For J = Nho To Lon
    Set sRng = CSDL(1).Resize(Rws).Find(J, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        [E2].Value = J
        sRng.Offset(, 2).Value = WF.DMin(CSDL, [B1], [E1:E2])
    End If
Next J
[E1:E2].Value = Space(0)
End Sub

Code nay của bác thì nó chỉ cho kết quả theo vào hàng với cái Min đầu tiên thôi.
Em đang muốn nó có ở các dòng khác như hình e minh họa đó bác

SA_DQ · 18/6/18

PHP:

Sub TimCucTieuTheoNam()
Dim WF As Object, CSDL As Range, sRng As Range
Dim Rws As Long, Nho As Integer, Lon As Integer, J As Long
Dim MyAdd As String                                     '*  '

Set WF = Application.WorksheetFunction
Rws = [A2].CurrentRegion.Rows.Count
Set CSDL = [A1].Resize(Rws, 2)
Nho = WF.Min(CSDL(1).Resize(Rws))
Lon = WF.Max(CSDL(1).Resize(Rws))
[e1].Value = [A1].Value
For J = Nho To Lon
    Set sRng = CSDL(1).Resize(Rws).Find(J, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        [E2].Value = J
        MyAdd = sRng.Address                            '*  '
        Do                                              '*  '
            sRng.Offset(, 2).Value = WF.DMin(CSDL, [B1], [E1:E2])
            Set sRng = CSDL.FindNext(sRng)              '*  '
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd    '*'
    End If
Next J
[E1:E2].Value = Space(0)
End Sub

anhtb82 · 23/6/18

SA_DQ đã viết:

PHP:

Sub TimCucTieuTheoNam()
Dim WF As Object, CSDL As Range, sRng As Range
Dim Rws As Long, Nho As Integer, Lon As Integer, J As Long
Dim MyAdd As String                                     '*  '

Set WF = Application.WorksheetFunction
Rws = [A2].CurrentRegion.Rows.Count
Set CSDL = [A1].Resize(Rws, 2)
Nho = WF.Min(CSDL(1).Resize(Rws))
Lon = WF.Max(CSDL(1).Resize(Rws))
[e1].Value = [A1].Value
For J = Nho To Lon
    Set sRng = CSDL(1).Resize(Rws).Find(J, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        [E2].Value = J
        MyAdd = sRng.Address                            '*  '
        Do                                              '*  '
            sRng.Offset(, 2).Value = WF.DMin(CSDL, [B1], [E1:E2])
            Set sRng = CSDL.FindNext(sRng)              '*  '
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd    '*'
    End If
Next J
[E1:E2].Value = Space(0)
End Sub

Nếu em tráo đổi cột như dưới đây thì sửa code đoạn nào vậy bác?

Tìm giá trị nhỏ nhất của từng năm (2 người xem)

Người dùng đang xem chủ đề này

Thành viên mới

File đính kèm

GPE - My love

Thành viên mới

GPE - My love

Huyền thoại GPE

/(hông là gì!

Thành viên mới

/(hông là gì!

GPE - My love

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

File đính kèm

GPE - My love

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

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

File đính kèm

Thành viên mới

File đính kèm

|||||||||||||

Ăn cùng góc phố

Thành viên mới

Thành viên mới

/(hông là gì!

Thành viên mới

Đếm ngược thời gian