Code lấy giá trị của 4 hoặc 5 số cuối. (1 người xem)

[LuuAnh980]

Chào các anh!!!
Em có file này, chủ yếu lấy những giá trị của 4 số hoặc 5 số không phải là "6000", "12000", và nhỏ hơn hoặc bằng 3000.
Nhưng trong cột F code không lấy giá trị "8X1500X10500" , mặc dù cột D có giá trị "8X1500X10500" cell D193, em bôi màu ạ.
Mong các anh giúp.

 

[bebo021999]

Code của bạn:
1- Dòng này chỉ lấy 4 ký tự, do đó các giá trị từ 10000 trở lên sẽ không có
valueEnd = Right(cell.Value, 4)
2- Code thao tác trực tiếp trên cell của sheet, nên dữ liệu lớn sẽ bị chậm

Do vậy dùng cái này nhé

Option Explicit
Sub FilterData()
Dim i&, j&, val, rng, res(1 To 100000, 1 To 1)
rng = Range("D4:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value
For i = 1 To UBound(rng)
    val = Right(rng(i, 1), 5)
    If Left(val, 1) = "X" Then val = Right(val, 4)
    val = CDbl(val)
    Select Case val
        Case Is <= 3000, 6000, 12000
        Case Else
            j = j + 1: res(j, 1) = rng(i, 1)
    End Select
Next
With Range("F4")
    .Resize(10000, 1).ClearContents
    .Resize(j, 1).Value = res
End With
End Sub

 

[LuuAnh980]

Dạ,em cám ơn anh @bebo021999 nhiều ạ.
Em mới coi lại, code anh @bebo021999 không filter duy nhất anh ơi, 8X1500X5030 có 2 lần anh ơi.

 

[Hai Lúa Miền Tây]

Chào các anh!!!
Em có file này, chủ yếu lấy những giá trị của 4 số hoặc 5 số không phải là "6000", "12000", và nhỏ hơn hoặc bằng 3000.
Nhưng trong cột F code không lấy giá trị "8X1500X10500" , mặc dù cột D có giá trị "8X1500X10500" cell D193, em bôi màu ạ.
Mong các anh giúp.

Kết quả ra như sau phải không bạn?

4X1500X3080

4X1500X3260

4X1500X4030

4X1500X4240

4X1500X4350

4X1500X4460

4X1500X4760

4X1500X4795

4X1500X4810

4X1500X4830

4X1500X5000

4X1500X5220

8X1500X10040

8X1500X10360

8X1500X10500

8X1500X11385

8X1500X5030

8X1500X6550

8X1500X6900

8X1500X7520

8X1500X7760

8X1500X7830

8X1500X8340

8X1500X8570

8X1500X8800

8X1500X8835

8X1500X8935

8X1500X9030

8X1500X9130

8X1500X9700

 

[LuuAnh980]

Dạ lấy giá tri duy nhất thôi ạ.

 

[Hai Lúa Miền Tây]

Dạ lấy giá tri duy nhất thôi ạ.

Giá trị duy nhất như thế nào bạn? Kết quả bài trên là duy nhất rồi còn gì.

 

[HeSanbi]

Bạn xem mã dưới đây đúng ý muốn của bạn không

Sub FilterData()

  Dim rng As Range, target As Range, a, p, lr&, d As Object, i&, k&
  Set d = CreateObject("Scripting.Dictionary"): d.CompareMode = 1
  Set rng = Range("D4").resize(ActiveSheet.UsedRange.Rows.Count,1)
  a = rng.Value: i = 1: lr = UBound(a)
  Set target = Range("L21")
  Do
    If CStr(a(i, 1)) Like "*[Xx]*" Then
      If Not d.exists(a(i, 1)) Then
        p = Split(a(i, 1), "x", , 1)
        Select Case CDec(p(UBound(p)))
        Case 6000, 12000, Is <= 3000:
        Case Else: d.Add a(i, 1), 0
        End Select
      End If
    End If
    i = i + 1
  Loop Until i > lr
  target.Resize(lr).ClearContents
  If d.Count Then target.Resize(d.Count).Value = Application.Transpose(d.keys)
End Sub

 

[bebo021999]

Dạ,em cám ơn anh @bebo021999 nhiều ạ.
Em mới coi lại, code anh @bebo021999 không filter duy nhất anh ơi, 8X1500X5030 có 2 lần anh ơi.

Vì bạn không yêu cầu từ đầu.
Thử lại, thêm cái dic vào nhé

Option Explicit
Sub FilterData()
Dim i&, j&, val, rng, res(1 To 100000, 1 To 1)
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
rng = Range("D4:D" & Cells(Rows.Count, "D").End(xlUp).Row).Value
For i = 1 To UBound(rng)
    val = Right(rng(i, 1), 5)
    If Left(val, 1) = "X" Then val = Right(val, 4)
    val = CDbl(val)
    Select Case val
        Case Is <= 3000, 6000, 12000
        Case Else
            If Not dic.Exits(rng(i, 1)) Then
                dic.Add rng(i, 1), ""
                j = j + 1: res(j, 1) = rng(i, 1)
            End If
    End Select
Next
With Range("F4")
    .Resize(10000, 1).ClearContents
    .Resize(j, 1).Value = res
End With
End Sub

 

[LuuAnh980]

Em có thử code của anh @HeSanbi thì lỗi như sau:


Code của anh @bebo021999 thì lỗi như sau:


Mong các anh giúp.

 

[Thóc Sama]

Em có thử code của anh @HeSanbi thì lỗi như sau:
View attachment 303615
View attachment 303616
Code của anh @bebo021999 thì lỗi như sau:
View attachment 303617
View attachment 303618
Mong các anh giúp.

Mình thấy có lỗi chính tả ở đây.

 If Not dic.Exits(rng(i, 1)) Then

bạn thêm chữ s như sau:

 If Not dic.Exists(rng(i, 1)) Then

xem được không nhé!

 

[HeSanbi]

Sửa lại compareMode = 1 bạn nhé

 

[LuuAnh980]

Filter qua F4 nha anh @HeSanbi , em không biết chỉnh code.

Bài đã được tự động gộp: 31/8/24

Code của anh @bebo021999 đúng là do lỗi chính tả ạ, cám ơn anh @Thóc Sama đã chỉ.
Cám ơn anh @bebo021999 và anh @Thóc Sama ạ.

 

[LuuAnh980]

code của anh @HeSanbi lấy không đúng anh ơi: lấy cả 6000,12000, <=3000 luôn

 

[HeSanbi]

Thêm ràng buộc Case Else bạn nhé

 

[LuuAnh980]

Sub FilterData()
  Dim rng As Range, a, p, lr&, d As Object, i&, k&, rng1 As Range
  Set d = CreateObject("Scripting.Dictionary"): d.CompareMode = 1
  Set rng = Range("D4:D220")
  Set rng1 = Range("L21:L220")
  a = rng.Value: i = 1: lr = UBound(a)
  Do
    If CStr(a(i, 1)) Like "*[Xx]*" Then
      If Not d.exists(a(i, 1)) Then
        p = Split(a(i, 1), "x", , 1)
        Select Case CDec(p(UBound(p)))
        Case 6000, 12000, Is <= 3000:
        Case Else: d.Add a(i, 1), 0
        End Select
      End If
    End If
    i = i + 1
  Loop Until i > lr
  rng1.ClearContents
  If d.Count Then rng1.Resize(d.Count).Value = Application.Transpose(d.keys)
End Sub

Code của anh @HeSanbi , em muốn gán kết quả Filter vào L21, em có chỉnh code lại, anh coi như vậy có được không ạ.

 

[VetMini]

Case thì 0 To 3000 chứ ai lại so <= 3000

Để lấy giá trị cuối sau dấu "X" thì dùng hàm InStrRev(chuỗi, "X", vbTextCompare)
Hoặc nếu chỉ cần thỏa điều kiện thì dùng Regex
"[Xx](([012]?\d{0,3})|3000|6000|12000)$"

 

[VetMini]

Code:

Sub LocTumLum()
Set rx = CreateObject("VBScript.Regexp") ' dung de loc
With rx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "[Xx](([012]?\d{0,3})|3000|6000|12000)$"
End With
Set dic = CreateObject("Scripting.Dictionary") ' dung de lay ma unnique
dic.Comparemode = vbTextCompare
For Each cll In Range("d4:d" & Cells(Rows.Count, "D").End(xlUp).Row)
If rx.test(cll.Value) Then dic(cll.Value) = ""
Next cll
Range("L21").Resize(dic.Count) = Application.Transpose(dic.keys)
End Sub

 

[ptm0412]

Code:

Sub LocTumLum()

Anh cũng ngứa tay hay là lễ nghỉ ở nhà chán quá? Hay là tôi vác Power query ra quánh luôn 1 bài?

 

[VetMini]

Anh cũng ngứa tay hay là lễ nghỉ ở nhà chán quá? Hay là tôi vác Power query ra quánh luôn 1 bài?

Không hẳn vậy. Toi chỉ giới thiệu rằng cái kiểu lọc bằng regex nó dễ chỉnh sửa hơn - trừ phi bên kia đưa điều kiện lọc khủng. Ở GPE này, nhiều chuyện khủng lắm.
GPE đáng lẽ lấy tên GPEK (K= khủng)

 

[ptm0412]

Không hẳn vậy.

Thôi kệ, tôi múa cái hàm let vậy

=LET(a,D4:D201,b,--TEXTAFTER(a,"X",-1),c,FILTER(a,(b>3000)*(b<>6000)*(b<>12000)),d,UNIQUE(c),d)

 

[LuuAnh980]

Code của Bác @VetMini chưa đúng ý ạ: điều kiện của em là không lấy <=3000,6000,12000
Code của bác @VetMini là lấy <=3000,6000,12000
Chỉnh chổ này dùm em ạ: .Pattern = "[Xx](([012]?\d{0,3})|3000|6000|12000)$"
Thầy @ptm0412 : Excel em là 2013, không có hàm mấy hàm đó ạ.
Cám ơn các anh nhiều ạ.

 

[Phan Thế Hiệp]

Excel em là 2013, không có hàm mấy hàm đó ạ.
Cám ơn các anh nhiều ạ.

Biết là thớt cần code VBA (tối ưu), nhưng thấy mấy dòng "đỏ đỏ" nên cũng 'ngứa tay' tạo công thức mảng để thớt tham khảo thêm cho biết. Ô F4 dán công thức sau:

=INDEX($D$4:$D$250,AGGREGATE(15,6,ROW($1:$250)/(MMULT(IFERROR(--TEXT(--RIGHT(SUBSTITUTE($D$4:$D$250,"X",REPT(" ",10),2),10),"[<3000]\0;[="&{3,6,12}*10^3&"]\0;\1"),),{1;1;1})=3)/(COUNTIF(OFFSET($D$4,,,ROW($1:$250)),$D$4:$D$250)=1),ROWS($1:1)))

Kết thúc bằng Ctrl+Shift+Enter, fill xuống.

Thân

 

[LuuAnh980]

Em cứ tưởng là công thức không làm được anh @Phan Thế Hiệp, nếu dữ liệu cỡ 2000 dòng có "quay đều" không anh.

 

[Phan Thế Hiệp]

Em cứ tưởng là công thức không làm được anh @Phan Thế Hiệp, nếu dữ liệu cỡ 2000 dòng có "quay đều" không anh.

Đã bảo 'tham khảo thêm' rồi mà! Chứ có nói "tối u" đâu!

Với khoảng 2000 dòng thì có thể..."quay đều, quay đều, quay đều. Nhớ hoài những vòng xe.." (Xe đạp ơi! Ngọc Lễ - Phương Thảo)


Thân

 

[Hoàng Tuấn 868]

Biết là thớt cần code VBA (tối ưu),
nhưng thấy mấy dòng "đỏ đỏ"

có nói "tối u" đâu!

Em sợ nhất những trường hợp đòi "tối ưu" vì có tiêu chuẩn thế nào là tối ưu đâu, không khéo lòng vòng một hồi lại trở thành "tối um". (Thường những trường hợp này mới biết một chút, hoặc chưa biết về VBA mới như vậy anh ạ).

 

[Hoàng Tuấn 868]

Chào các anh!!!

..... ..... ..... ..... .....

 

[HeSanbi]

em muốn gán kết quả Filter vào L21, em có chỉnh code lại, anh coi như vậy có được không ạ.

Bạn chép lại mã #7
Để gán phím tắt sử dụng thì bạn cần xác định chính xác trang tính cần thực hiện. Lấy codeName của trang tính đó, như sau:

Sheet1.Range("D4") và Sheet1.Range("L21")

Gán phím tắt CTRL+SHIFT+F4, chạy thủ tục sau:

Private Sub assignShortKey()
   On Error Resume Next
   Application.OnKeys "^+{F4}", "'" & ThisWorkbook.Name & "'!FilterData"
End Sub

 

[LuuAnh980]

Cám ơn anh @HeSanbi nhiều ạ.
Thêm điều kiện bẫy lỗi nữa đi anh, vì có trường hợp không có các giá trị cần lấy. ví dụ chỉ có <=3000, 6000 và 12000 thôi.

 

[Phan Thế Hiệp]

Điều kiện của bạn không rõ ràng, bạn nêu mỗi điều kiện vào một gạch đầu dòng xem cụ thể thế nào.

(Hết ngứa tay bây giờ ngứa miệng)

Dạ anh!
Em muốn lọc dãy số cột D, với điều kiện
1/ Số cuối cùng (sau "X" thứ 2) thỏa: không lấy các giá trị
- <= 3000 và
- = 6000 và
- = 12000
2/ Nếu giá trị đã thỏa điều kiện '1/' xuất hiện trùng lặp, thì chỉ lấy giá trị đó 1 lần.

Rõ không anh!?

 

[HeSanbi]

Lỗi diễn ra khi nào bạn.
Có ràng buộc d.count đó thôi

 

[LuuAnh980]

Lỗi diễn ra khi nào bạn.
Có ràng buộc d.count đó thôi

Ý em là khi filter mà không có thỏa điều kiện thì hiện MsgBox"khong co du lieu", như là D4250 trắng hoặc có dữ liệu nhưng chỉ có<=3000,6000,12000 thôi.

 

[Hoàng Tuấn 868]

(Hết ngứa tay bây giờ ngứa miệng)
Dạ anh!
Em muốn lọc dãy số cột D, với điều kiện
1/ Số cuối cùng (sau "X" thứ 2) thỏa: không lấy các giá trị
- <= 3000 và
- = 6000 và
- = 12000
2/ Nếu giá trị đã thỏa điều kiện '1/' xuất hiện trùng lặp, thì chỉ lấy giá trị đó 1 lần.
Rõ không anh!?

Hết ngứa tay xoay ra ngứa miệng. Chính xác rồi anh ơi.
Nếu nêu ra như thế này ngay từ bài #1 thì chắc không kéo dài mấy chục bài như bây giờ, nhưng đây cũng là đặc thù của chủ bài mất rồi.

 

[HeSanbi]

Vậy chỉ cần thêm mã

If d.count then

Else
    Msgbox
End if

 

[ptm0412]

Biết là thớt cần code VBA (tối ưu), nhưng thấy mấy dòng "đỏ đỏ" nên cũng 'ngứa tay' tạo công thức mảng để thớt tham khảo thêm cho biết.

Một trong những cái khủng.

 

[VetMini]

Tôi đã hứa không dính líu gì nữa rồi.
Vả lại, hàng của tôi không bao giờ là "tối ưu" cho nên cũng chả chết ai.

Điểm ưu việt của nó là "dễ chỉnh sửa" mà không thấy thì nó chỉ là đồ bỏ.
Dễ chỉnh sửa: thuận thì IF ..., không thuận thì IF Not ...

 

[ptm0412]

Code của Bác @VetMini chưa đúng ý ạ: điều kiện của em là không lấy <=3000,6000,12000
Code của bác @VetMini là lấy <=3000,6000,12000
Chỉnh chổ này dùm em ạ: .Pattern = "[Xx](([012]?\d{0,3})|3000|6000|12000)$"

Theo tôi thì nguyên chủ đề này:
Bài 1 không nói gì đến duy nhất. Điều kiện thì không ghi rõ ràng.
- Khi có code bài 2 thì mới đòi duy nhất và đòi sửa. Sửa xong thì không nói năng gì, chắc không xài
- Bài 4 đưa kết quả hỏi, nếu đúng thì làm. Chê không duy nhất mặc dù đã duy nhất rồi. Sau đó lơ luôn không dùng
- Code bài 7 sau khi sửa 2 lần, cũng lơ luôn không xài
- Code bài 17 không biết có xài hay không, mà cũng đòi sửa.
Đòi cho cố vô rồi không thấy vừa lòng. Sau cùng xài cái nào chắc theo kiểu hên xui. Phải chi mà biết đánh giá code nào tốt hơn thì tôi không nói, đằng này 1 chữ VBA bẻ đôi không biết!
Với cách hỏi này và cách đòi hỏi này nếu là người khác thì tôi mắng (bạn gọi là chửi). Nhưng riêng bạn thì tôi lơ luôn lâu rồi.
Luôn luôn hỏi, rồi đòi tốt hơn, rồi có khi không dùng cái nào mà vẫn làm theo ý mình.
Có lẽ dần dần rồi những người giúp xong bị ngó lơ cũng sẽ không bao giờ giúp nữa rồi đừng hỏi tại sao.
Ghi chú:
(Tôi viết hàm let để cho người khác đọc dù biết chắc là bạn không có 365)

 

[thang_nguyen1]

Biết là thớt cần code VBA (tối ưu), nhưng thấy mấy dòng "đỏ đỏ" nên cũng 'ngứa tay' tạo công thức mảng để thớt tham khảo thêm cho biết. Ô F4 dán công thức sau:

=INDEX($D$4:$D$250,AGGREGATE(15,6,ROW($1:$250)/(MMULT(IFERROR(--TEXT(--RIGHT(SUBSTITUTE($D$4:$D$250,"X",REPT(" ",10),2),10),"[<3000]\0;[="&{3,6,12}*10^3&"]\0;\1"),),{1;1;1})=3)/(COUNTIF(OFFSET($D$4,,,ROW($1:$250)),$D$4:$D$250)=1),ROWS($1:1)))

Kết thúc bằng Ctrl+Shift+Enter, fill xuống.

Thân

Bạn giỏi hàm excel thật đấy