Giúp Công Thức Hoặc Code Sum Vlookup Từng số (1 người xem)

[Phúc Lộc Thọ]

Em chào đại gia đình. Em cần công thức dò VLookup từng số sau đó Sum lại như hình mô tả bên dưới. Rất mong đại gia đình giúp đỡ
v

 

[Ngày mai trời lại sáng]

Data lần này có lẽ chỉ có 9 dòng tương ứng từ 1 đến 9 ,.. có 11,12...,123,.. đến mấy chục ngàn dòng nữa vậy bạn?

 

[BuiQuangThuan]

Em chào đại gia đình. Em cần công thức dò VLookup từng số sau đó Sum lại như hình mô tả bên dưới. Rất mong đại gia đình giúp đỡ
v

Lắm bài toán lạ nhỉ. Cái này không còn phải là vlookup nữa rồi. Dữ liệu nó có lớn lắm không?

 

[Phúc Lộc Thọ]

Data lần này có lẽ chỉ có 9 dòng tương ứng từ 1 đến 9 ,.. có 11,12...,123,.. đến mấy chục ngàn dòng nữa vậy bạn?

Mình cần giúp đỡ. Rất mong bạn giúp mình

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

Lắm bài toán lạ nhỉ. Cái này không còn phải là vlookup nữa rồi. Dữ liệu nó có lớn lắm không?

Rất mong bạn giúp đỡ vì mục đích sử dụng của mình là như vậy

 

[huonglien1901]

Em chào đại gia đình. Em cần công thức dò VLookup từng số sau đó Sum lại như hình mô tả bên dưới. Rất mong đại gia đình giúp đỡ
v

Công thức cho nhẹ nha!
=SUMPRODUCT(ISNUMBER(SEARCH(""&$B$4:$B$12&"",""&E4&""))*$C$4:$C$12)

 

[Ngày mai trời lại sáng]

Mình cần giúp đỡ. Rất mong bạn giúp mình

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

Rất mong bạn giúp đỡ vì mục đích sử dụng của mình là như vậy

Ok bạn, mình cũng học bạn, cũng gọi là 'góp vui' :

Option Explicit
Sub aeaaaaaeeaaaaeaaeaeaaea()
Dim aeeeeeaeeeeaaaeeaaeaaaa As Object
Dim aaaaaaaeeeaeeaaaaeaeeea As Variant, aaeaaaaeaaaeaeeaeeeaaaa As Variant
Dim eaaeaeeeaeaaeeeaaaaaeaa As String, eaeeaaeaeaaeaaeeeaeeeee As String
Dim eaaeeaeeeeaaeeeeeaeaeaa As Long, eaaaeeeaaaaaaeaeeeeeeea As Integer
Const aeaeaaeeeaaeeeeaeeaeeea As Long = 100000
Const eeaaaeeeaaaeeeeeaaaaaae As String = "Scripting.Dictionary"
aaaaaaaeeeaeeaaaaeaeeea = Sheet1.Range("B4:C12").Value
Set aeeeeeaeeeeaaaeeaaeaaaa = CreateObject(eeaaaeeeaaaeeeeeaaaaaae)
For eaaeeaeeeeaaeeeeeaeaeaa = LBound(aaaaaaaeeeaeeaaaaeaeeea, 1) To UBound(aaaaaaaeeeaeeaaaaeaeeea, 1) Step 1
eaaeaeeeaeaaeeeaaaaaeaa = CStr(aaaaaaaeeeaeeaaaaeaeeea(eaaeeaeeeeaaeeeeeaeaeaa, 1))
If Not aeeeeeaeeeeaaaeeaaeaaaa.exists(eaaeaeeeaeaaeeeaaaaaeaa) Then
aeeeeeaeeeeaaaeeaaeaaaa.Add eaaeaeeeaeaaeeeaaaaaeaa, aaaaaaaeeeaeeaaaaeaeeea(eaaeeaeeeeaaeeeeeaeaeaa, 2)
End If
Next eaaeeaeeeeaaeeeeeaeaeaa
aaaaaaaeeeaeeaaaaeaeeea = Sheet1.Range("E4:F" & Sheet1.Range("E" & aeaeaaeeeaaeeeeaeeaeeea).End(xlUp).Row).Value
ReDim aaeaaaaeaaaeaeeaeeeaaaa(1 To UBound(aaaaaaaeeeaeeaaaaeaeeea, 1), 1 To UBound(aaaaaaaeeeaeeaaaaeaeeea, 2))
For eaaeeaeeeeaaeeeeeaeaeaa = LBound(aaaaaaaeeeaeeaaaaeaeeea, 1) To UBound(aaaaaaaeeeaeeaaaaeaeeea, 1) Step 1
eaeeaaeaeaaeaaeeeaeeeee = aaaaaaaeeeaeeaaaaeaeeea(eaaeeaeeeeaaeeeeeaeaeaa, 1)
For eaaaeeeaaaaaaeaeeeeeeea = Len(eaeeaaeaeaaeaaeeeaeeeee) To 1 Step -1
eaaeaeeeaeaaeeeaaaaaeaa = Mid(eaeeaaeaeaaeaaeeeaeeeee, eaaaeeeaaaaaaeaeeeeeeea, 1)
If aeeeeeaeeeeaaaeeaaeaaaa.exists(eaaeaeeeaeaaeeeaaaaaeaa) Then
aaeaaaaeaaaeaeeaeeeaaaa(eaaeeaeeeeaaeeeeeaeaeaa, 1) = aaaaaaaeeeaeeaaaaeaeeea(eaaeeaeeeeaaeeeeeaeaeaa, 1)
aaeaaaaeaaaeaeeaeeeaaaa(eaaeeaeeeeaaeeeeeaeaeaa, 2) = aaeaaaaeaaaeaeeaeeeaaaa(eaaeeaeeeeaaeeeeeaeaeaa, 2) + aeeeeeaeeeeaaaeeaaeaaaa.Item(eaaeaeeeaeaaeeeaaaaaeaa)
End If
Next eaaaeeeaaaaaaeaeeeeeeea
Next eaaeeaeeeeaaeeeeeaeaeaa
Sheet1.Range("E4").Resize(aeaeaaeeeaaeeeeaeeaeeea, UBound(aaeaaaaeaaaeaeeaeeeaaaa, 2)).ClearContents
Sheet1.Range("E4").Resize(UBound(aaeaaaaeaaaeaeeaeeeaaaa, 1), UBound(aaeaaaaeaaaeaeeaeeeaaaa, 2)).Value = aaeaaaaeaaaeaeeaeeeaaaa
End Sub

 

[Phúc Lộc Thọ]

Ok bạn, mình cũng học bạn, cũng gọi là 'góp vui' :

Option Explicit
Sub aeaaaaaeeaaaaeaaeaeaaea()
Dim aeeeeeaeeeeaaaeeaaeaaaa As Object
Dim aaaaaaaeeeaeeaaaaeaeeea As Variant, aaeaaaaeaaaeaeeaeeeaaaa As Variant
Dim eaaeaeeeaeaaeeeaaaaaeaa As String, eaeeaaeaeaaeaaeeeaeeeee As String
Dim eaaeeaeeeeaaeeeeeaeaeaa As Long, eaaaeeeaaaaaaeaeeeeeeea As Integer
Const aeaeaaeeeaaeeeeaeeaeeea As Long = 100000
Const eeaaaeeeaaaeeeeeaaaaaae As String = "Scripting.Dictionary"
aaaaaaaeeeaeeaaaaeaeeea = Sheet1.Range("B4:C12").Value
Set aeeeeeaeeeeaaaeeaaeaaaa = CreateObject(eeaaaeeeaaaeeeeeaaaaaae)
For eaaeeaeeeeaaeeeeeaeaeaa = LBound(aaaaaaaeeeaeeaaaaeaeeea, 1) To UBound(aaaaaaaeeeaeeaaaaeaeeea, 1) Step 1
eaaeaeeeaeaaeeeaaaaaeaa = CStr(aaaaaaaeeeaeeaaaaeaeeea(eaaeeaeeeeaaeeeeeaeaeaa, 1))
If Not aeeeeeaeeeeaaaeeaaeaaaa.exists(eaaeaeeeaeaaeeeaaaaaeaa) Then
aeeeeeaeeeeaaaeeaaeaaaa.Add eaaeaeeeaeaaeeeaaaaaeaa, aaaaaaaeeeaeeaaaaeaeeea(eaaeeaeeeeaaeeeeeaeaeaa, 2)
End If
Next eaaeeaeeeeaaeeeeeaeaeaa
aaaaaaaeeeaeeaaaaeaeeea = Sheet1.Range("E4:F" & Sheet1.Range("E" & aeaeaaeeeaaeeeeaeeaeeea).End(xlUp).Row).Value
ReDim aaeaaaaeaaaeaeeaeeeaaaa(1 To UBound(aaaaaaaeeeaeeaaaaeaeeea, 1), 1 To UBound(aaaaaaaeeeaeeaaaaeaeeea, 2))
For eaaeeaeeeeaaeeeeeaeaeaa = LBound(aaaaaaaeeeaeeaaaaeaeeea, 1) To UBound(aaaaaaaeeeaeeaaaaeaeeea, 1) Step 1
eaeeaaeaeaaeaaeeeaeeeee = aaaaaaaeeeaeeaaaaeaeeea(eaaeeaeeeeaaeeeeeaeaeaa, 1)
For eaaaeeeaaaaaaeaeeeeeeea = Len(eaeeaaeaeaaeaaeeeaeeeee) To 1 Step -1
eaaeaeeeaeaaeeeaaaaaeaa = Mid(eaeeaaeaeaaeaaeeeaeeeee, eaaaeeeaaaaaaeaeeeeeeea, 1)
If aeeeeeaeeeeaaaeeaaeaaaa.exists(eaaeaeeeaeaaeeeaaaaaeaa) Then
aaeaaaaeaaaeaeeaeeeaaaa(eaaeeaeeeeaaeeeeeaeaeaa, 1) = aaaaaaaeeeaeeaaaaeaeeea(eaaeeaeeeeaaeeeeeaeaeaa, 1)
aaeaaaaeaaaeaeeaeeeaaaa(eaaeeaeeeeaaeeeeeaeaeaa, 2) = aaeaaaaeaaaeaeeaeeeaaaa(eaaeeaeeeeaaeeeeeaeaeaa, 2) + aeeeeeaeeeeaaaeeaaeaaaa.Item(eaaeaeeeaeaaeeeaaaaaeaa)
End If
Next eaaaeeeaaaaaaeaeeeeeeea
Next eaaeeaeeeeaaeeeeeaeaeaa
Sheet1.Range("E4").Resize(aeaeaaeeeaaeeeeaeeaeeea, UBound(aaeaaaaeaaaeaeeaeeeaaaa, 2)).ClearContents
Sheet1.Range("E4").Resize(UBound(aaeaaaaeaaaeaeeaeeeaaaa, 1), UBound(aaeaaaaeaaaeaeeaeeeaaaa, 2)).Value = aaeaaaaeaaaeaeeaeeeaaaa
End Sub

Giúp người khác không nên làm khó vậy.

Sub Lumcode()
Dim q As Object
Dim w As Variant, e As Variant
Dim r As String, t As String
Dim y As Long, u As Integer
Const i As Long = 100000
Const o As String = "Scripting.Dictionary"
w = Sheet1.Range("B4:C12").Value
Set q = CreateObject(o)
For y = LBound(w, 1) To UBound(w, 1) Step 1
r = CStr(w(y, 1))
If Not q.exists(r) Then
q.Add r, w(y, 2)
End If
Next y
w = Sheet1.Range("E4:F" & Sheet1.Range("E" & i).End(xlUp).Row).Value
ReDim e(1 To UBound(w, 1), 1 To UBound(w, 2))
For y = LBound(w, 1) To UBound(w, 1) Step 1
t = w(y, 1)
For u = Len(t) To 1 Step -1
r = Mid(t, u, 1)
If q.exists(r) Then
e(y, 1) = w(y, 1)
e(y, 2) = e(y, 2) + q.Item(r)
End If
Next u
Next y
Sheet1.Range("E4").Resize(i, UBound(e, 2)).ClearContents
Sheet1.Range("E4").Resize(UBound(e, 1), UBound(e, 2)).Value = e
End Sub

 

[Ngày mai trời lại sáng]

Giúp người khác không nên làm khó vậy.

Sub Lumcode()
Dim q As Object
Dim w As Variant, e As Variant
Dim r As String, t As String
Dim y As Long, u As Integer
Const i As Long = 100000
Const o As String = "Scripting.Dictionary"
w = Sheet1.Range("B4:C12").Value
Set q = CreateObject(o)
For y = LBound(w, 1) To UBound(w, 1) Step 1
r = CStr(w(y, 1))
If Not q.exists(r) Then
q.Add r, w(y, 2)
End If
Next y
w = Sheet1.Range("E4:F" & Sheet1.Range("E" & i).End(xlUp).Row).Value
ReDim e(1 To UBound(w, 1), 1 To UBound(w, 2))
For y = LBound(w, 1) To UBound(w, 1) Step 1
t = w(y, 1)
For u = Len(t) To 1 Step -1
r = Mid(t, u, 1)
If q.exists(r) Then
e(y, 1) = w(y, 1)
e(y, 2) = e(y, 2) + q.Item(r)
End If
Next u
Next y
Sheet1.Range("E4").Resize(i, UBound(e, 2)).ClearContents
Sheet1.Range("E4").Resize(UBound(e, 1), UBound(e, 2)).Value = e
End Sub

dịch nhanh siêu thế lại còn bảo khó nữa kìa

 

[Phúc Lộc Thọ]

Công thức cho nhẹ nha!
=SUMPRODUCT(ISNUMBER(SEARCH(""&$B$4:$B$12&"",""&E4&""))*$C$4:$C$12)

Nếu em gõ 2 số giống nhau nó cộng sai anh ơi Ví dụ em gõ giá trị là 1122 thì Kết quả phải là 50+50+70+70

 

[Ngày mai trời lại sáng]

Nếu em gõ 2 số giống nhau nó cộng sai anh ơi Ví dụ em gõ giá trị là 1122 thì Kết quả phải là 50+50+70+70

Có gì "góp vui" chưa bạn để mình còn đi ngủ?

 

[BuiQuangThuan]

Có gì "góp vui" chưa bạn để mình còn đi ngủ?

Hơi sợ kiểu góp vui này. Có lẽ ngồi xem hay hơn

 

[Phúc Lộc Thọ]

Có gì "góp vui" chưa bạn để mình còn đi ngủ?

Thường mình sẽ góp vui sau 1 2 ngày, Và cái góp vui của mình sẽ gọn hơn code bạn 10 lần + Nhanh hơn 2 lần .

 

[VetMini]

Hơi sợ kiểu góp vui này. Có lẽ ngồi xem hay hơn

Bạn không đọc kỹ lời tôi phân tích. "góp vui" chỉ xảy ra khi bài đã được giải.
Và cái góp vui thường là cái dạy lại người giải (code gọn hơn, nhanh hơn)
Trừ 2 người được kính nể, là không hề dám chạm tới.

 

[Phuocam]

Thử

=SUMPRODUCT(SUMIF($B$4:$B$12,--MID(E4,ROW(INDIRECT("1:"&LEN(E4))),1),$C$4:$C$12))

Công thức cho excel 365

=SUMPRODUCT(SUMIF($B$4:$B$12,--MID(E4,SEQUENCE(LEN(E4)),1),$C$4:$C$12))

 

[Ngày mai trời lại sáng]

Thường mình sẽ góp vui sau 1 2 ngày, Và cái góp vui của mình sẽ gọn hơn code bạn 10 lần + Nhanh hơn 2 lần .

Thiệt sự hôm qua giờ này đã tắt máy đi ngủ rồi, nhưng vì thấy nói như vậy:

Nên lại mò dậy... nếu phát biểu:
"Và cái góp vui của mình sẽ gọn hơn code bạn 10 lần + Nhanh hơn 2 lần ."
thì có lẽ mọi chuyện không phải kéo dài đến bây giờ.
Với mình chủ đề này coi như đã vào sọt rác, ai muốn viết thêm gì thì viết,chẳng hơi đâu mà bận tâm.

 

[bebo021999]

Option Explicit
Sub add()
Dim i&, j&, ma As Range, kq, st As String
kq = Range("E4:F" & Cells(Rows.Count, "E").End(xlUp).Row).Value
Set ma = Range("B4:B" & Cells(Rows.Count, "B").End(xlUp).Row)
For i = 1 To UBound(kq)
    st = ""
    For j = 1 To Len(kq(i, 1))
        st = IIf(st = "", "", st & ",") & Mid(kq(i, 1), j, 1)
    Next
    st = "{" & st & "}"
    kq(i, 2) = Evaluate("=SUM(SUMIF(" & ma.Address & "," & st & "," & ma.Offset(, 1).Address & "))")
Next
Range("E4:F100000").ClearContents
Range("E4:F" & UBound(kq)).Value = kq
End Sub

 

[VetMini]

Option Explicit
Sub add()
...
End Sub

Yên tâm. Lần này tôi không chỉ cho thớt mánh viết nhanh hơn 10-100 lần đâu.
Thớt muốn thì phải học qua thần tượng của mình.

 

[HieuCD]

Yên tâm. Lần này tôi không chỉ cho thớt mánh viết nhanh hơn 10-100 lần đâu.
Thớt muốn thì phải học qua thần tượng của mình.

Code bài #16 chậm hơn bài #6 nhiều, code bài #6 do dùng dic nên rườm rà và tốn tí thời gian xử lý dic nhưng không thể có code mới nhanh hơn 2 lần

 

[Phúc Lộc Thọ]

Code bài #16 chậm hơn bài #6 nhiều, code bài #6 do dùng dic nên rườm rà và tốn tí thời gian xử lý dic nhưng không thể có code mới nhanh hơn 2 lần

Nhanh hơn 2 lần và gọn hơn code kia 20 lần dùng Evaluate + Replace

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

Yên tâm. Lần này tôi không chỉ cho thớt mánh viết nhanh hơn 10-100 lần đâu.
Thớt muốn thì phải học qua thần tượng của mình.

Evaluate + Replace tôi cần tư vấn thuật toán này

 

[Ngày mai trời lại sáng]

Code bài #16 chậm hơn bài #6 nhiều, code bài #6 do dùng dic nên rườm rà và tốn tí thời gian xử lý dic nhưng không thể có code mới nhanh hơn 2 lần

Thực ra mới đầu cháu viết ngắn hơn chút, nhưng chính vì để cho nhìn vào thấy rối như tơ vò hơn nên cháu thêm thắt vài tham số.. nhưng nó chẳng quan trọng , quan trọng vẫn là cách xử lý..
Nhưng mà thớt "bản tính" vẫn trước sau như một thôi thì bỏ qua đi chú, cháu cũng đã nói suy nghĩ của mình ở bài 15 rồi.. nếu nhìn thấy người thực sự gặp khó mà trong khả năng của mình có thể giúp thì mình có mất mát một chút cũng cảm thấy vui..