Tìm ô cuối cùng thỏa mãn điều kiện. (1 người xem)

chibi · 26/7/10

Chào cả nhà.
Tôi có vùng dữ liệu gồm 2 cột (A-B) và nhiều dòng, được sắp xếp theo cột A. Cần tìm ô cuối cùng (Từ trên xuống) trên cột A có giá trị cho trước, nếu tìm thấy thì trả về giá trị của ô tương ứng bên cột B, nếu không thì trả về 1.
Ngoài cách duyệt từng ô, anh/chị nào có cách khác xin được chỉ giáo.

duongdv · 26/7/10

Chibi ơi! Bạn cho một file ví dụ minh hoạ để anh em cùng suy nghĩ xem sao?

chibi · 26/7/10

Ví dụ:

|A|B
1|a|7
2|b|8
3|b|9
4|c|6
5|c|5
6|c|4
7|d|3

Tìm a trả về 7 (ô B1)
Tìm b trả về 9 (ô B3)
Tìm c trả về 4 (ô B6)
Tìm d trả về 3 (ô B7)
Tìm e trả về 1 (Không tìm thấy)

concogia · 26/7/10

chibi đã viết:
Ví dụ:

|A|B
1|a|7
2|b|8
3|b|9
4|c|6
5|c|5
6|c|4
7|d|3

Tìm a trả về 7 (ô B1)
Tìm b trả về 9 (ô B3)
Tìm c trả về 4 (ô B6)
Tìm d trả về 3 (ô B7)
Tìm e trả về 1 (Không tìm thấy)

Thử thế này xem, không biết đúng chưa nữa

duongdv · 26/7/10

Chi bi xem như thế này có đúng ý không?

ndu96081631 · 26/7/10

Ủa! Bài này trong box lập trình cơ mà!

PHP:

Function LastVal(FVal, FRng As Range, ColIndex As Long)
  Dim Tmp As Range
  Set Tmp = FRng.Resize(, 1).Find(FVal, , xlValues, xlWhole, , xlPrevious)
  If Not Tmp Is Nothing Then LastVal = Tmp(, ColIndex).Value
End Function

Dùng Find Method với SearchDirection = xlPrevious thôi (tìm ngược từ dưới lên)

huuthang_bd · 26/7/10

ndu96081631 đã viết:
Ủa! Bài này trong box lập trình cơ mà!

PHP:

Function LastVal(FVal, FRng As Range, ColIndex As Long) Dim Tmp As Range Set Tmp = FRng.Resize(, 1).Find(FVal, , xlValues, xlWhole, , xlPrevious) If Not Tmp Is Nothing Then LastVal = Tmp(, ColIndex).Value End Function

Dùng Find Method với SearchDirection = xlPrevious thôi (tìm ngược từ dưới lên)

Code này còn thiếu đoạn "nếu không tìm thấy thì trả về giá trị là 1"

ndu96081631 · 26/7/10

huuthang_bd đã viết:
Code này còn thiếu đoạn "nếu không tìm thấy thì trả về giá trị là 1"

Hi... hi... Thuật toán là vậy! Chibi là chuyên gia (chứ có phải tay thường đâu) nên thừa sức làm mấy cái IF này nếu bạn ấy muốn

chibi · 26/7/10

Cảm ơn các anh, chị nhiều.
Tôi đang vướng khi dùng Find Method sẽ không tìm được nếu FRng bị hide.

TrungChinhs · 26/7/10

chibi đã viết:
Cảm ơn các anh, chị nhiều.
Tôi đang vướng khi dùng Find Method sẽ không tìm được nếu FRng bị hide.

Không biết có đúng ý bạn không ? Hide cả dòng và cột vẫn tìm bình thường

PHP:

Sub Tim_Cuoi()
On Error Resume Next
    For Each cls In [j15:j1000].SpecialCells(2)
        tmp = [b2:b1000].SpecialCells(2).Find(cls, , , 2, 1, 2, 1).Address
        If tmp > 0 Then cls(1, 2) = Range(tmp)(1, 2)
        tmp = ""
    Next
End Sub

chibi · 26/7/10

Cảm ơn anh Trung Chinh (Đồng hương Nam Định). Vấn đề là không dùng

Mã:

 For Each

rollover79 · 27/7/10

Về yêu cầu của vấn đề này không có gì phức tạp, nếu không phải là chủ topic đang đánh đố(không cho dùng vòng lặp) thì theo tôi có lẽ vấn đề liên quan đến tốc độ xử lý(dữ liệu lớn chẳng hạn). Bình thường thì dùng Find như của bác ndu thì khỏi phải bản. Tôi xin gửi 1 phương pháp khác như sau:

Mã:

Function LastValVB(rngSearch As Range, rngReturn As Range, fndValue)
    Dim sTemp As String
    sTemp = vbBack & Join(WorksheetFunction.Transpose(rngSearch), vbBack) & vbBack
    fndValue = vbBack & fndValue & vbBack
    Dim iRet As Integer
    iRet = InStrRev(sTemp, fndValue)
    If iRet > 1 Then
        iRet = iRet - Len(Replace(Left(sTemp, iRet), vbBack, ""))
    End If
    If iRet > 0 Then
        LastValVB = rngReturn(iRet)
    Else
        LastValVB = 1
    End If
End Function

Function LastValJS(rngSearch As Range, rngReturn As Range, fndValue)
    Dim arrTemp
    arrTemp = WorksheetFunction.Transpose(rngSearch)
    Dim sCommand As String
    Dim jsString As String
    jsString = "('" & vbBack & Join(arrTemp, vbBack) & vbBack & "')"
    sCommand = jsString & ".lastIndexOf('" & vbBack & fndValue & vbBack & "')"
    Dim iRet As Integer
    Dim objSC
    Set objSC = CreateObject("MSScriptControl.ScriptControl")
    objSC.Language = "JavaScript"
    iRet = objSC.Eval(sCommand)
    If iRet > 0 Then
        sCommand = jsString & ".substr(0," & iRet & ").replace(/" & vbBack & "/g,'').length"
        iRet = iRet - objSC.Eval(sCommand)
    End If
    If iRet >= 0 Then
        LastValJS = rngReturn(iRet + 1)
    Else
        LastValJS = 1
    End If
End Function

Cả 2 hàm trên đều chung tư tưởng xử lý, có điều 1 hàm sử dụng hoàn toàn VBA, 1 hàm không chính thống sử dụng qua ngôn ngữ trung gian là JavaScript, tôi chưa có điều kiện test thử về tốc độ do không có dữ liệu thật. Không rõ có đáp ứng được yêu cầu của bạn hay không. Lưu ý thêm ở đây tôi đang giả sử là xử lý theo cột, nếu xử lý theo dòng thì thêm 1 hàm Transpose lồng vào nhau nữa. Tùy vào tình huống sử dụng có thể chỉ Transpose 1 lần rồi lưu lại để sử dụng thay vì lần nào cũng phải Transpose vì với dữ liệu nhiều thì hàm này cũng gây chậm tốc độ xử lý.

ThuNghi · 27/7/10

rollover79 đã viết:

Mã:

Function LastValVB(rngSearch As Range, rngReturn As Range, fndValue)
    Dim sTemp As String
    sTemp = vbBack & Join(WorksheetFunction.Transpose(rngSearch), vbBack) & vbBack
    fndValue = vbBack & fndValue & vbBack
    Dim iRet As Integer
    iRet = InStrRev(sTemp, fndValue)
    If iRet > 1 Then
        iRet = iRet - Len(Replace(Left(sTemp, iRet), vbBack, ""))
    End If
    If iRet > 0 Then
        LastValVB = rngReturn(iRet)
    Else
        LastValVB = 1
    End If
End Function

Function LastValJS(rngSearch As Range, rngReturn As Range, fndValue)
    Dim arrTemp
    arrTemp = WorksheetFunction.Transpose(rngSearch)
    Dim sCommand As String
    Dim jsString As String
    jsString = "('" & vbBack & Join(arrTemp, vbBack) & vbBack & "')"
    sCommand = jsString & ".lastIndexOf('" & vbBack & fndValue & vbBack & "')"
    Dim iRet As Integer
    Dim objSC
    Set objSC = CreateObject("MSScriptControl.ScriptControl")
    objSC.Language = "JavaScript"
    iRet = objSC.Eval(sCommand)
    If iRet > 0 Then
        sCommand = jsString & ".substr(0," & iRet & ").replace(/" & vbBack & "/g,'').length"
        iRet = iRet - objSC.Eval(sCommand)
    End If
    If iRet >= 0 Then
        LastValJS = rngReturn(iRet + 1)
    Else
        LastValJS = 1
    End If
End Function

Cả 2 hàm trên đều chung tư tưởng xử lý, có điều 1 hàm sử dụng hoàn toàn VBA, 1 hàm không chính thống sử dụng qua ngôn ngữ trung gian là JavaScript

Do chưa đụng đến JavaCript, nếu có điều kiện nhờ RollOver giải nghĩa các dòng code trên để mình vận dụng.
Cám ơn nhiều.

ndu96081631 · 27/7/10

ThuNghi đã viết:
Do chưa đụng đến JavaCript, nếu có điều kiện nhờ RollOver giải nghĩa các dòng code trên để mình vận dụng.
Cám ơn nhiều.

Tôi đoán được mấy dòng:
- arrTemp = WorksheetFunction.Transpose(rngSearch) ---> Biến Range thành mảng 1 chiều
- jsString = "('" & vbBack & Join(arrTemp, vbBack) & vbBack & "')" ---> Nối các phần tử mảng với dấu phân cách là vbBack
- sCommand = jsString & ".lastIndexOf('" & vbBack & fndValue & vbBack & "')" ---> Có lẽ trong ngôn ngữ JavaScript có phương thức LastIndexOf(...) chăng?
- iRet = objSC.Eval(sCommand) ---> Thực thi lệnh từ chuổi (chứa câu lệnh)
-----------------
Gần giống với phương pháp VBA là nối chuổi, sau đó dùng InStrRev để dò ngược!

rollover79 · 27/7/10

ndu96081631 đã viết:
Tôi đoán được mấy dòng:
- arrTemp = WorksheetFunction.Transpose(rngSearch) ---> Biến Range thành mảng 1 chiều
- jsString = "('" & vbBack & Join(arrTemp, vbBack) & vbBack & "')" ---> Nối các phần tử mảng với dấu phân cách là vbBack
- sCommand = jsString & ".lastIndexOf('" & vbBack & fndValue & vbBack & "')" ---> Có lẽ trong ngôn ngữ JavaScript có phương thức LastIndexOf(...) chăng?
- iRet = objSC.Eval(sCommand) ---> Thực thi lệnh từ chuổi (chứa câu lệnh)
-----------------
Gần giống với phương pháp VBA là nối chuổi, sau đó dùng InStrRev để dò ngược!

Chính xác là lastIndexOf tương đương với InStrRev, bởi vậy nên ở đây tôi mới nói là tư tưởng là tương đương nhau. Sở dĩ tôi post cả 2 phương pháp là vì tôi có cảm giác JavaScript có khả năng xử lý tốc độ tốt hơn(Không dám chắc chắn). Lưu ý thêm là với JavaScript thì có phân biệt chứ hoa vào chữ thường nên LastIndexOf sẽ khác lastIndexOf

ndu96081631 · 27/7/10

Cũng dựa trên cơ sở nối chuổi như rollover79 nhưng thay vì dùng lastIndexOf hoặc InStrRev, tôi dùng hàm Filter có sẳn trong VBA

PHP:

Function LastVal(FVal, FindRng As Range, RestRng As Range)
  Dim Arr, Tmp As String, FilterArr
  LastVal = 1
  On Error Resume Next
  Arr = Evaluate("Transpose(char(8)&" & FindRng.Address & "&char(8)&" & RestRng.Address & "&char(8))")
  Tmp = vbBack & FVal & vbBack
  FilterArr = Filter(Arr, Tmp)
  LastVal = Replace(Replace(FilterArr(UBound(FilterArr)), Tmp, ""), vbBack, "")
End Function

Các bạn kiểm tra giúp xem có chổ nào không ổn không?

chibi · 31/7/10

ndu96081631 đã viết:
Cũng dựa trên cơ sở nối chuổi như rollover79 nhưng thay vì dùng lastIndexOf hoặc InStrRev, tôi dùng hàm Filter có sẳn trong VBA

PHP:

Function LastVal(FVal, FindRng As Range, RestRng As Range) Dim Arr, Tmp As String, FilterArr LastVal = 1 On Error Resume Next Arr = Evaluate("Transpose(char(8)&" & FindRng.Address & "&char(8)&" & RestRng.Address & "&char(8))") Tmp = vbBack & FVal & vbBack FilterArr = Filter(Arr, Tmp) LastVal = Replace(Replace(FilterArr(UBound(FilterArr)), Tmp, ""), vbBack, "") End Function

Các bạn kiểm tra giúp xem có chổ nào không ổn không?

Đã thử, chưa gặp bất trắc gì. Cảm ơn nhiều.

haonlh · 31/7/10

Xin hỏi Chibi:
Mạo muội làm trực tiếp bằng công thức ngay trong bảng tính có được không.
Nếu được, xin gửi file đính kèm

Chú ý phải sort cột B, giảm dần

chibi · 31/7/10

haonlh đã viết:
Xin hỏi Chibi:
Mạo muội làm trực tiếp bằng công thức ngay trong bảng tính có được không.
Nếu được, xin gửi file đính kèm

Chú ý phải sort cột B, giảm dần

Cảm ơn bạn, mình đọc mà vẫn chưa hiểu. Có thể chưa đúng ý mình.

haonlh · 2/8/10

chibi đã viết:
Cảm ơn bạn, mình đọc mà vẫn chưa hiểu. Có thể chưa đúng ý mình.

Chào chibi.
Tôi hiểu sai ý của anh, nên đưa trả lời như trên theo nghĩa khác, cụ thể là: Tìm giá trị lớn nhất của ...
Nay đọc lại, hiểu ý của anh là : tìm giá trị cuối cùng của ...

Cho nên, ta thêm cột thứ tự, Sort cột đó giảm dần, và làm công thức như trên. Có lẽ cũng không cần gửi file đính kèm

Tìm ô cuối cùng thỏa mãn điều kiện. (1 người xem)

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

Thành viên tích cực

Thành viên tích cực

Thành viên tích cực

Gội rồi mới Cạo

File đính kèm

Thành viên tích cực

File đính kèm

Huyền thoại GPE

Chuyên gia GPE

Huyền thoại GPE

Thành viên tích cực

Thành viên tích cực

File đính kèm

Thành viên tích cực

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

Hãy cho rồi sẽ nhận!

Huyền thoại GPE

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

Huyền thoại GPE

Thành viên tích cực

Thành viên tích cực

File đính kèm

Thành viên tích cực

Thành viên tích cực

Đếm ngược thời gian