Giúp Công Thức Hoặc Code Sum Vlookup Từng số

Liên hệ QC
P

Phúc Lộc Thọ

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia
12/8/22
Bài viết
32
Được thích
4
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
 

File đính kèm

  • Untitled.png
    Untitled.png
    150.1 KB · Đọc: 44
  • sumvlookup.xlsx
    10.3 KB · Đọc: 26
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Upvote 0
Ngày mai trời lại sáng đã viết:
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?
Nhấp chuột vào đây để mở rộng...
Mình cần giúp đỡ. Rất mong bạn giúp mình
Bài đã được tự động gộp:

BuiQuangThuan đã viết:
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?
Nhấp chuột vào đây để mở rộng...
Rất mong bạn giúp đỡ vì mục đích sử dụng của mình là như vậy
 
Upvote 0
Upvote 0
Phúc Lộc Thọ đã viết:
Mình cần giúp đỡ. Rất mong bạn giúp mình
Bài đã được tự động gộp:


Rất mong bạn giúp đỡ vì mục đích sử dụng của mình là như vậy
Nhấp chuột vào đây để mở rộng...

Ok bạn, mình cũng học bạn, cũng gọi là 'góp vui' :
Mã: 
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
 
Upvote 0
Ngày mai trời lại sáng đã viết:
Ok bạn, mình cũng học bạn, cũng gọi là 'góp vui' :
Mã: 
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
Nhấp chuột vào đây để mở rộ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
 
Upvote 0
Phúc Lộc Thọ đã viết:
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
Nhấp chuột vào đây để mở rộng...
dịch nhanh siêu thế lại còn bảo khó nữa kìa :D
 
Upvote 0
BuiQuangThuan đã viết:
Hơi sợ kiểu góp vui này. Có lẽ ngồi xem hay hơn
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
Phúc Lộc Thọ đã viết:
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 .
Nhấp chuột vào đây để mở rộng...
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:
1661747572849.png
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.
 
Upvote 0
PHP: 
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
 

File đính kèm

  • sumvlookup.xlsm
    20.3 KB · Đọc: 16
Upvote 0
VetMini đã viết:
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.
Nhấp chuột vào đây để mở rộ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
 
Upvote 0
HieuCD đã viết:
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
Nhấp chuột vào đây để mở rộng...
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:

VetMini đã viết:
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.
Nhấp chuột vào đây để mở rộng...
Evaluate + Replace tôi cần tư vấn thuật toán này
 
Upvote 0
HieuCD đã viết:
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
Nhấp chuột vào đây để mở rộng...
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..
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

louistom2511
Thêm 15 số 100, 15 số 200 cho đến 12k
Trả lời
3
Đọc
6
louistom2511
louistom2511
senna
  • Question
Trích xuất dữ liệu từ ảnh vào bảng tính Excel
Trả lời
0
Đọc
1
senna
senna
B
Xin hướng dẫn về transpose theo dữ liệu cố định ngày tháng (hoặc pivot)
Trả lời
3
Đọc
91
bicutit
B
PhanTuHuong
Chương trình lập Báo cáo khảo sát Địa chất công trình GeoSection
    • Thích
Trả lời
6
Đọc
5K
PhanTuHuong
PhanTuHuong
Tuấn Bụng Bự
  • Question
Hiển thị UserForm theo vị trí ô cell được chọn
Trả lời
9
Đọc
373
hoangtuan.net
hoangtuan.net
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom