VBA thay thế cho hàm SUMPRODUCT để cải thiện tốc độ tính toán (1 người xem)

  • Thread starter Thread starter huongmai
  • Ngày gửi Ngày gửi
Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
H

huongmai

Thành viên mới
Tham gia
28/11/08
Bài viết
40
Được thích
1
Chào các bác,

Em có một file excel tổng hợp kế hoạch xuất hàng dùng công thức SUMPRODUCT, nó chạy chậm kinh khủng, gần 1h mới xong.

Em có đọc trên diễn đàn thấy có nói đến việc sử dụng VBA để thay cho hàm Sumproduct sẽ cải thiện được tốc độ, nhưng vì mới đang tập tành tìm hiểu nên làm hoài không được.

Em post file lên đây (dữ liệu em đã xóa đi quá nửa vì dung lượng vượt quá quy định của GPE)

Nhờ các bác chỉ giáo giùm.

Chân thành cảm ơn các bác
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
huongmai đã viết:
Chào các bác,

Em có một file excel tổng hợp kế hoạch xuất hàng dùng công thức SUMPRODUCT, nó chạy chậm kinh khủng, gần 1h mới xong.

Em có đọc trên diễn đàn thấy có nói đến việc sử dụng VBA để thay cho hàm Sumproduct sẽ cải thiện được tốc độ, nhưng vì mới đang tập tành tìm hiểu nên làm hoài không được.

Em post file lên đây (dữ liệu em đã xóa đi quá nửa vì dung lượng vượt quá quy định của GPE)

Nhờ các bác chỉ giáo giùm.

Thanks alot
Nhấp chuột vào đây để mở rộng...

Gặp cái Chữ màu đỏ "mắc ghét".
Viết code rồi. Nếu bạn sửa lại cái chữ màu đỏ trên thì tôi gởi code lên cho.
 
Upvote 0
hpkhuong đã viết:
Nếu không dùng VBA thì nên chuyển từ Sumproduct sang hàm sumifs xem, tốc độ cải thiện hơn đó bạn. Nhưng bên sheet dữ liệu nguồn phải làm 2 cột phụ tách tháng & năm
Nhấp chuột vào đây để mở rộng...

Mình có rất nhiều bảng kiểu này, sử dụng sumifs thì nhanh hơn chút nhưng mình không muốn sử dụng cột phụ
Bạn có rành về VBA chỉ giúp mình nhé.
Cảm ơn bạn.
Hương
 
Upvote 0
Cứ thấy hơi khó một chút là VBA, riết rồi bà con lười suy nghĩ quá.
Bài này chỉ cần dùing Pivot table, group by Months là xong.

@chủ thớt: lối xưng hô dùng tiếng ngoại là lối của bạn bè chơi games với nhau. Bạn không thể dùng bừa bãi rồi phê bình người khác khó tính.
 
Upvote 0
VetMini đã viết:
Cứ thấy hơi khó một chút là VBA, riết rồi bà con lười suy nghĩ quá.
Bài này chỉ cần dùing Pivot table, group by Months là xong.

@chủ thớt: lối xưng hô dùng tiếng ngoại là lối của bạn bè chơi games với nhau. Bạn không thể dùng bừa bãi rồi phê bình người khác khó tính.
Nhấp chuột vào đây để mở rộng...

Mình làm trước nay vẫn toàn dùng công thức thôi, giờ muốn học hỏi thêm về VBA để cải thiện công việc
Pivot Table cũng chưa làm bao giờ, nhưng mình sẽ tìm hiểu sau.
Giờ nếu có thể, nhờ bác chỉ giùm code VBA trong trường hợp này được không ạ? biết nhiều cách để so sánh hiệu quả và áp dụng cho phù hợp cũng tốt mà.
Cảm ơn bác nhiều.
Hương.

@: chỉ 1 câu cảm ơn bằng tiếng anh chứ không phải xưng hô gì mà mọi người phản ứng ghê quá. Sẽ rút kinh nghiệm. Vô cùng xin lỗi mọi người
 
Lần chỉnh sửa cuối:
Upvote 0
huongmai đã viết:
Mình làm trước nay vẫn toàn dùng công thức thôi, giờ muốn học hỏi thêm về VBA để cải thiện công việc
Pivot Table cũng chưa làm bao giờ, nhưng mình sẽ tìm hiểu sau.
Giờ nếu có thể, nhờ bác chỉ giùm code VBA trong trường hợp này được không ạ? biết nhiều cách để so sánh hiệu quả và áp dụng cho phù hợp cũng tốt mà.
Nhấp chuột vào đây để mở rộng...

Cá với bạn rằng PivotTable là vô địch, không có code VBA nào có tốc độ hơn nó đâu
Đã vậy, với PivotTable thì học và hành trong vòng vài phút là có thể tự làm được
 
Upvote 0
huongmai đã viết:
Mình làm trước nay vẫn toàn dùng công thức thôi, giờ muốn học hỏi thêm về VBA để cải thiện công việc
Pivot Table cũng chưa làm bao giờ, nhưng mình sẽ tìm hiểu sau.
Giờ nếu có thể, nhờ bác chỉ giùm code VBA trong trường hợp này được không ạ? biết nhiều cách để so sánh hiệu quả và áp dụng cho phù hợp cũng tốt mà.
Cảm ơn bác nhiều.
Hương.

@: chỉ 1 câu cảm ơn bằng tiếng anh chứ không phải xưng hô gì mà mọi người phản ứng ghê quá. Sẽ rút kinh nghiệm. Vô cùng xin lỗi mọi người
Nhấp chuột vào đây để mở rộng...

@ Đang trao đổi bằng tiếng Việt, "xỏ" vào 1 câu tiếng Anh là sao?
Ta đây là "thời thượng"? Trình độ hơn "Hai Lúa"?
Code "Hai Lúa" chẳng biết 1 câu tiếng Anh nè, nếu chưa xài được Pivot Table thì xài đỡ, kết quả chưa đúng thì tính sau:
PHP: 
Public Sub GPE()
Dim Dic As Object, sArr(), tArr(), dArr(), I As Long, J As Long, Tem As String, Ngay As String, C As Long, R As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("fc")
    sArr = .Range(.[A2], .[A2].End(xlDown)).Resize(, 3).Value
End With
    For I = 1 To UBound(sArr, 1)
        Ngay = Year(sArr(I, 2)) & "-" & Month(sArr(I, 2))
        Tem = sArr(I, 1) & "-" & Ngay
        If Not Dic.Exists(Tem) Then
            Dic.Add Tem, sArr(I, 3)
        Else
            Dic.Item(Tem) = Dic.Item(Tem) + sArr(I, 3)
        End If
    Next I
With Sheets("data")
    tArr = .Range(.[C2], .[C2].End(xlToRight)).Value
    C = UBound(tArr, 2)
    sArr = .Range(.[B3], .[B3].End(xlDown)).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R, 1 To C)
    For I = 1 To R
        For J = 1 To C
            Tem = sArr(I, 1) & "-" & Year(tArr(1, J)) & "-" & Month(tArr(1, J))
            If Dic.Exists(Tem) Then dArr(I, J) = Dic.Item(Tem)
        Next J
    Next I
    .[C3].Resize(R, C) = dArr
End With
Set Dic = Nothing
End Sub
ndu96081631 đã viết:
Cá với bạn rằng PivotTable là vô địch, không có code VBA nào có tốc độ hơn nó đâu
Đã vậy, với PivotTable thì học và hành trong vòng vài phút là có thể tự làm được
Nhấp chuột vào đây để mở rộng...
Dữ liệu cột B sheet "data" không hoàn toàn có trong cột A sheet "fc", Pivot Table có kết quả được như vậy không ta?
(Thấy sao nói vậy nghe "bồ", không tranh cãi chuyện Pivot Table à nghe)
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
@ Đang trao đổi bằng tiếng Việt, "xỏ" vào 1 câu tiếng Anh là sao?
Ta đây là "thời thượng"? Trình độ hơn "Hai Lúa"?
Code "Hai Lúa" chẳng biết 1 câu tiếng Anh nè, nếu chưa xài được Pivot Table thì xài đỡ, kết quả chưa đúng thì tính sau:
PHP: 
Public Sub GPE()
Dim Dic As Object, sArr(), tArr(), dArr(), I As Long, J As Long, Tem As String, Ngay As String, C As Long, R As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("fc")
    sArr = .Range(.[A2], .[A2].End(xlDown)).Resize(, 3).Value
End With
    For I = 1 To UBound(sArr, 1)
        Ngay = Year(sArr(I, 2)) & "-" & Month(sArr(I, 2))
        Tem = sArr(I, 1) & "-" & Ngay
        If Not Dic.Exists(Tem) Then
            Dic.Add Tem, sArr(I, 3)
        Else
            Dic.Item(Tem) = Dic.Item(Tem) + sArr(I, 3)
        End If
    Next I
With Sheets("data")
    tArr = .Range(.[C2], .[C2].End(xlToRight)).Value
    C = UBound(tArr, 2)
    sArr = .Range(.[B3], .[B3].End(xlDown)).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R, 1 To C)
    For I = 1 To R
        For J = 1 To C
            Tem = sArr(I, 1) & "-" & Year(tArr(1, J)) & "-" & Month(tArr(1, J))
            If Dic.Exists(Tem) Then dArr(I, J) = Dic.Item(Tem)
        Next J
    Next I
    .[C3].Resize(R, C) = dArr
End With
Set Dic = Nothing
End Sub

Dữ liệu cột B sheet "data" không hoàn toàn có trong cột A sheet "fc", Pivot Table có kết quả được như vậy không ta?
(Thấy sao nói vậy nghe "bồ", không tranh cãi chuyện Pivot Table à nghe)
Nhấp chuột vào đây để mở rộng...

Kết quả chính xác. Cám ơn bác rất nhiều.
Nhưng nếu những ô không có số lượng mà muốn điền giá trị = 0 vào thì sửa code như thế nào bác nhỉ?
Mong bác chỉ giúp ạ.
Cảm ơn bác.
 
Upvote 0
huongmai đã viết:
Kết quả chính xác. Cám ơn bác rất nhiều.
Nhưng nếu những ô không có số lượng mà muốn điền giá trị = 0 vào thì sửa code như thế nào bác nhỉ?
Mong bác chỉ giúp ạ.
Cảm ơn bác.
Nhấp chuột vào đây để mở rộng...
Thử thay dòng lệnh
PHP: 
If Dic.Exists(Tem) Then dArr(I, J) = Dic.Item(Tem)

Thành thế này
PHP: 
            If Dic.Exists(Tem) Then
               dArr(I, J) = Dic.Item(Tem)
            Else
               dArr(I, J) = 0
            End If
 
Upvote 0
Vẫn ở vấn đề hàm Sumproduct ạ,
Em có một bảng tổng hợp theo điều kiện là phần ghi chú có chứa chuỗi ký tự cần tổng hợp.
Loay hoay từ sáng tới giờ thử nghiệm các câu lệnh về chuỗi (tìm trên internet) + dựa vào code các bác hướng dẫn ở trên mà không được.
Em gửi file có chứa công thức SUMPRODUCT như ban đầu để các bác xem giúp ạ
Đưa lên đây chắc các bác nghĩ em lười suy nghĩ, dốt.... nhưng mà Em mới tập tành làm VBA nên còn bỡ ngỡ lắm ạ.
Mong được sự giúp đỡ.
Em xin cảm ơn.
 

File đính kèm

Upvote 0
huongmai đã viết:
Vẫn ở vấn đề hàm Sumproduct ạ,
Em có một bảng tổng hợp theo điều kiện là phần ghi chú có chứa chuỗi ký tự cần tổng hợp.
Loay hoay từ sáng tới giờ thử nghiệm các câu lệnh về chuỗi (tìm trên internet) + dựa vào code các bác hướng dẫn ở trên mà không được.
Em gửi file có chứa công thức SUMPRODUCT như ban đầu để các bác xem giúp ạ
Đưa lên đây chắc các bác nghĩ em lười suy nghĩ, dốt.... nhưng mà Em mới tập tành làm VBA nên còn bỡ ngỡ lắm ạ.
Mong được sự giúp đỡ.
Em xin cảm ơn.
Nhấp chuột vào đây để mở rộng...

Dùng hàm sao "quái" vậy? SUMIFS() đơn giản hơn:
PHP: 
Sheet data, C3=SUMIFS(KQ!$B$2:$B$2000;KQ!$A$2:$A$2000;$B3;KQ!$C$2:$C$2000;C$2)
Code thì chỉnh lại chút thôi:
PHP: 
Public Sub GPE()
Dim Dic As Object, sArr(), tArr(), dArr(), I As Long, J As Long, Tem As String, C As Long, R As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("KQ")
    sArr = .Range(.[A2], .[A2].End(xlDown)).Resize(, 3).Value
End With
    For I = 1 To UBound(sArr, 1)
        Tem = sArr(I, 1) & "-" & sArr(I, 3)
        If Not Dic.exists(Tem) Then
            Dic.Add Tem, sArr(I, 2)
        Else
            Dic.Item(Tem) = Dic.Item(Tem) + sArr(I, 2)
        End If
    Next I
With Sheets("data")
    tArr = .Range(.[C2], .[C2].End(xlToRight)).Value
    C = UBound(tArr, 2)
    sArr = .Range(.[B3], .[B3].End(xlDown)).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R, 1 To C)
    For I = 1 To R
        For J = 1 To C
            Tem = sArr(I, 1) & "-" & tArr(1, J)
            If Dic.exists(Tem) Then
                dArr(I, J) = Dic.Item(Tem)
            Else
                dArr(I, J) = 0
            End If
        Next J
    Next I
    .[C3].Resize(R, C) = dArr
End With
Set Dic = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
huongmai đã viết:
Vẫn ở vấn đề hàm Sumproduct ạ,
Em có một bảng tổng hợp theo điều kiện là phần ghi chú có chứa chuỗi ký tự cần tổng hợp.
Loay hoay từ sáng tới giờ thử nghiệm các câu lệnh về chuỗi (tìm trên internet) + dựa vào code các bác hướng dẫn ở trên mà không được.
Em gửi file có chứa công thức SUMPRODUCT như ban đầu để các bác xem giúp ạ
Đưa lên đây chắc các bác nghĩ em lười suy nghĩ, dốt.... nhưng mà Em mới tập tành làm VBA nên còn bỡ ngỡ lắm ạ.
Mong được sự giúp đỡ.
Em xin cảm ơn.
Nhấp chuột vào đây để mở rộng...

tôi cứ lẫn lộn giữa sheet "KQ" (kêt quả?) và sheet "data"
làm mò gần chết...........haiz...............góp thêm một cách, đổ mồi hôi hột
Mã: 
Sub GiDo()
Dim data, kq, tam As Variant, i, j, k As Long, d As Object, st As String
With Sheets("KQ")
    kq = .[a2].Resize(.[a60000].End(3).Row - 1, 3)
End With
With Sheets("data")
    .[c3:k60000].ClearContents
    data = .[b3].Resize(.[b60000].End(3).Row - 2, 10)
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(kq)
    If kq(i, 3) Like "V*" Then
     tam = Split(kq(i, 3), "(")
     st = Trim(tam(0))
        If Not d.Exists(kq(i, 1) & "#" & st) Then
            d.Add kq(i, 1) & "#" & st, kq(i, 2)
        Else
            d.Item(kq(i, 1) & "#" & st) = d.Item(kq(i, 1) & "#" & st) + kq(i, 2)
        End If
    End If
Next


For i = 1 To UBound(data)
    For j = 1 To 9
        If d.Exists(data(i, 1) & "#" & "V" & j) Then
            data(i, j + 1) = d.Item(data(i, 1) & "#" & "V" & j)
        End If
    Next
Next
With Sheets("data")
  .[b3].Resize(.[b60000].End(3).Row - 2, 10) = data
End With
Set d = Nothing
End Sub

với cái hàm Find của bạn hình như nó không phân biệt được V1 với V11,V12...., bạn kiểm tra lại xem
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi không hiểu bạn đã nghiên cứu công thức mảng chưa?
 
Upvote 0
Ba Tê đã viết:
Dùng hàm sao "quái" vậy? SUMIFS() đơn giản hơn:
PHP: 
Sheet data, C3=SUMIFS(KQ!$B$2:$B$2000;KQ!$A$2:$A$2000;$B3;KQ!$C$2:$C$2000;C$2)
Code thì chỉnh lại chút thôi:
PHP: 
Public Sub GPE()
Dim Dic As Object, sArr(), tArr(), dArr(), I As Long, J As Long, Tem As String, C As Long, R As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("KQ")
    sArr = .Range(.[A2], .[A2].End(xlDown)).Resize(, 3).Value
End With
    For I = 1 To UBound(sArr, 1)
        Tem = sArr(I, 1) & "-" & sArr(I, 3)
        If Not Dic.exists(Tem) Then
            Dic.Add Tem, sArr(I, 2)
        Else
            Dic.Item(Tem) = Dic.Item(Tem) + sArr(I, 2)
        End If
    Next I
With Sheets("data")
    tArr = .Range(.[C2], .[C2].End(xlToRight)).Value
    C = UBound(tArr, 2)
    sArr = .Range(.[B3], .[B3].End(xlDown)).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R, 1 To C)
    For I = 1 To R
        For J = 1 To C
            Tem = sArr(I, 1) & "-" & tArr(1, J)
            If Dic.exists(Tem) Then
                dArr(I, J) = Dic.Item(Tem)
            Else
                dArr(I, J) = 0
            End If
        Next J
    Next I
    .[C3].Resize(R, C) = dArr
End With
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

Cảm ơn bác đã trợ giúp ạ.
Vấn đề em phải sử dụng công thức Sumproduct thay vì Sumifs vì dữ liệu trong cột ghi chú nhiều khi có ghi kèm cả các ký tự khác ngoài ký tự điều kiện.
Ví dụ:
[TABLE="width: 440"]
[TR]
[TD][TABLE="width: 440"]
[TR]
[TD]Y2178001[/TD]
[TD]25800[/TD]
[TD]V1[/TD]
[/TR]
[TR]
[TD]Y2178001[/TD]
[TD]21600[/TD]
[TD]V1 (ND 30/05)[/TD]
[/TR]
[/TABLE]
[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[/TABLE]
Code bác gửi cũng bỏ qua mất những ghi chú có kèm ký tự khác điều kiện này ạ --> Kết quả chưa chính xác.
Nhờ bác trợ giúp thêm ạ.
Cảm ơn bác nhiều.
 
Upvote 0
Let'GâuGâu đã viết:
tôi cứ lẫn lộn giữa sheet "KQ" (kêt quả?) và sheet "data"
làm mò gần chết...........haiz...............góp thêm một cách, đổ mồi hôi hột
Mã: 
Sub GiDo()
Dim data, kq, tam As Variant, i, j, k As Long, d As Object, st As String
With Sheets("KQ")
    kq = .[a2].Resize(.[a60000].End(3).Row - 1, 3)
End With
With Sheets("data")
    .[c3:k60000].ClearContents
    data = .[b3].Resize(.[b60000].End(3).Row - 2, 10)
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(kq)
    If kq(i, 3) Like "V*" Then
     tam = Split(kq(i, 3), "(")
     st = Trim(tam(0))
        If Not d.Exists(kq(i, 1) & "#" & st) Then
            d.Add kq(i, 1) & "#" & st, kq(i, 2)
        Else
            d.Item(kq(i, 1) & "#" & st) = d.Item(kq(i, 1) & "#" & st) + kq(i, 2)
        End If
    End If
Next


For i = 1 To UBound(data)
    For j = 1 To 9
        If d.Exists(data(i, 1) & "#" & "V" & j) Then
            data(i, j + 1) = d.Item(data(i, 1) & "#" & "V" & j)
        End If
    Next
Next
With Sheets("data")
  .[b3].Resize(.[b60000].End(3).Row - 2, 10) = data
End With
Set d = Nothing
End Sub

với cái hàm Find của bạn hình như nó không phân biệt được V1 với V11,V12...., bạn kiểm tra lại xem
Nhấp chuột vào đây để mở rộng...

hì hì... đúng là cái hàm Find của em không phân biệt được V1 với V11, V12.... nên em phải cộng trừ kiểu Sum(V1) = Sum(V1)-Sum(V1*) ---> Gà thế đấy ạ.
Bác có công thức nào chỉ cho em với.

Còn phần code của bác em thử thấy đúng với các điều kiện từ V1--> V9, nhưng code này là sắp xếp đúng theo thứ tự V1-->V9
Vậy nếu không sắp xếp cố định, và ngoài V* còn có các ký tự khác thì sửa code như thế nào ạ?
VD: ở hàng 2 sheet data:
[TABLE="width: 818"]
[TR]
[TD="class: xl93, width: 63"]V1[/TD]
[TD="class: xl93, width: 67"]V1`[/TD]
[TD="class: xl93, width: 77"]V2[/TD]
[TD="class: xl93, width: 71"]V3[/TD]
[TD="class: xl93, width: 72"]V3`[/TD]
[TD="class: xl93, width: 71"]V11[/TD]
[TD="class: xl93, width: 60"]V11`[/TD]
[TD="class: xl93, width: 55"]M2[/TD]
[TD="class: xl93, width: 60"]M3[/TD]
[TD="class: xl93, width: 58"]MT[/TD]
[TD="class: xl93, width: 56"]T1[/TD]
[TD="class: xl93, width: 55"]T3[/TD]
[TD="class: xl93, width: 53"]….[/TD]
[/TR]
[/TABLE]
Nhờ bác chỉ giúp.
Cảm ơn bác nhiều.
 
Lần chỉnh sửa cuối:
Upvote 0
huongmai đã viết:
hì hì... đúng là cái hàm Find của em không phân biệt được V1 với V11, V12.... nên em phải cộng trừ kiểu Sum(V1) = Sum(V1)-Sum(V1*) ---> Gà thế đấy ạ.
Bác có công thức nào chỉ cho em với.

Còn phần code của bác em thử thấy đúng với các điều kiện từ V1--> V9, nhưng code này là sắp xếp đúng theo thứ tự V1-->V9
Vậy nếu không sắp xếp cố định, và ngoài V* còn có các ký tự khác thì sửa code như thế nào ạ?
VD: ở hàng 2 sheet data:
[TABLE="width: 818"]
[TR]
[TD="class: xl93, width: 63"]V1[/TD]
[TD="class: xl93, width: 67"]V1`[/TD]
[TD="class: xl93, width: 77"]V2[/TD]
[TD="class: xl93, width: 71"]V3[/TD]
[TD="class: xl93, width: 72"]V3`[/TD]
[TD="class: xl93, width: 71"]V11[/TD]
[TD="class: xl93, width: 60"]V11`[/TD]
[TD="class: xl93, width: 55"]M2[/TD]
[TD="class: xl93, width: 60"]M3[/TD]
[TD="class: xl93, width: 58"]MT[/TD]
[TD="class: xl93, width: 56"]T1[/TD]
[TD="class: xl93, width: 55"]T3[/TD]
[TD="class: xl93, width: 53"]….[/TD]
[/TR]
[/TABLE]
Nhờ bác chỉ giúp.
Cảm ơn bác nhiều.
Nhấp chuột vào đây để mở rộng...
Nếu hàng thứ 2 sheet Data đã sắp xếp thứ tự như vậy thì bạn dò theo thứ tự ngược lại bằng select case với like, khi đó nếu dò được V11 rồi thì sẽ thoát luôn không cộng vào V1 nữa. (Với điều kiện là Data phải có đầy đủ các V).
 
Upvote 0
huongmai đã viết:
hì hì... đúng là cái hàm Find của em không phân biệt được V1 với V11, V12.... nên em phải cộng trừ kiểu Sum(V1) = Sum(V1)-Sum(V1*) ---> Gà thế đấy ạ.
Bác có công thức nào chỉ cho em với.

Còn phần code của bác em thử thấy đúng với các điều kiện từ V1--> V9, nhưng code này là sắp xếp đúng theo thứ tự V1-->V9
Vậy nếu không sắp xếp cố định, và ngoài V* còn có các ký tự khác thì sửa code như thế nào ạ?
VD: ở hàng 2 sheet data:
[TABLE="width: 818"]
[TR]
[TD="class: xl93, width: 63"]V1[/TD]
[TD="class: xl93, width: 67"]V1`[/TD]
[TD="class: xl93, width: 77"]V2[/TD]
[TD="class: xl93, width: 71"]V3[/TD]
[TD="class: xl93, width: 72"]V3`[/TD]
[TD="class: xl93, width: 71"]V11[/TD]
[TD="class: xl93, width: 60"]V11`[/TD]
[TD="class: xl93, width: 55"]M2[/TD]
[TD="class: xl93, width: 60"]M3[/TD]
[TD="class: xl93, width: 58"]MT[/TD]
[TD="class: xl93, width: 56"]T1[/TD]
[TD="class: xl93, width: 55"]T3[/TD]
[TD="class: xl93, width: 53"]….[/TD]
[/TR]
[/TABLE]
Nhờ bác chỉ giúp.
Cảm ơn bác nhiều.
Nhấp chuột vào đây để mở rộng...

thử code sau xem
Mã: 
Sub GiDo()
Dim data, kq, tam, v As Variant, i, j, k As Long, d As Object, st As String, col_Rng, rw_Rng As Range, r, c

With Sheets("KQ")
    kq = .[a2].Resize(.[a60000].End(3).Row - 1, 3)
End With
With Sheets("data")
    .[c3:k60000].ClearContents
    data = .[B3].Resize(.[b60000].End(3).Row - 2, 10)
    Set col_Rng = .Range(.[B2], .[c2].End(2))
    Set rw_Rng = Range(.[B3], .[b60000].End(3))
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(kq)
    If kq(i, 3) <> "" Then
     tam = Split(kq(i, 3), "(")
     st = Trim(tam(0))
        If Not d.Exists(kq(i, 1) & "#" & st) Then
            d.Add kq(i, 1) & "#" & st, kq(i, 2)
        Else
            d.Item(kq(i, 1) & "#" & st) = d.Item(kq(i, 1) & "#" & st) + kq(i, 2)
        End If
    End If
Next

For Each v In d
    tam = Split(v, "#")
    On Error Resume Next
    c = Application.Match(tam(1), col_Rng, 0)
    r = Application.Match(tam(0), rw_Rng, 0)
    data(r, c) = d.Item(v)
On Error GoTo 0
Next
With Sheets("data")
  .[B3].Resize(.[b60000].End(3).Row - 2, 10) = data
End With
Set d = Nothing
End Sub
====================
cách truyền thống thì như vậy (dự trù cách kia có gì sai)
Mã: 
Sub GiDo()
Dim col, data, kq, tam, v As Variant, i, j, k As Long, d As Object, st As String
With Sheets("KQ")
    kq = .[a2].Resize(.[a60000].End(3).Row - 1, 3)
End With
With Sheets("data")
    .[c3:k60000].ClearContents
    data = .[B3].Resize(.[b60000].End(3).Row - 2, 10)
    col = Range(.[C2], .[C2].End(2)).Value
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(kq)
    If kq(i, 3) <> "" Then
     tam = Split(kq(i, 3), "(")
     st = Trim(tam(0))
        If Not d.exists(kq(i, 1) & "#" & st) Then
            d.Add kq(i, 1) & "#" & st, kq(i, 2)
        Else
            d.Item(kq(i, 1) & "#" & st) = d.Item(kq(i, 1) & "#" & st) + kq(i, 2)
        End If
    End If
Next

For i = 1 To UBound(data)
    For j = 1 To UBound(col, 2)
        If d.exists(data(i, 1) & "#" & col(1, j)) Then
            data(i, j + 1) = d.Item(data(i, 1) & "#" & col(1, j))
        End If
    Next
Next
            
With Sheets("data")
  .[B3].Resize(.[b60000].End(3).Row - 2, 10) = data
End With
Set d = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

B
Sau 1 tháng Mã Lại reset về 1 trở lên (1 người xem)
Trả lời
6
Đọc
83
ongke0711
ongke0711
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
411
Đọc
50K
ongke0711
ongke0711
H
Đánh số thứ thự phiếu thu chi
Trả lời
11
Đọc
159
HangktGTN
H
H
Tìm kiếm thông tin chi tiết trên sheet tổng hợp
Trả lời
1
Đọc
51
LOGANWover
L
N
  • Question Question
Cho em hỏi về mail merge bằng vba
Trả lời
3
Đọc
85
Hoàng Tuấn 868
H
T
Xin hỏi về bảng lương (1 người xem)
Trả lời
0
Đọc
47
tuandovn
T
Gà Công Nghệ
Tô màu họ và tên bị trùng từ 2 sheet khác nhau
Trả lời
6
Đọc
105
Gà Công Nghệ
Gà Công Nghệ
A
  • Question Question
Giải thích giúp mình code giải phóng bộ nhớ từ biến
Trả lời
20
Đọc
9K
nguyendang95
N
Nguyenkhang2404
giúp đỡ lọc dữ liệu nâng cao
Trả lời
22
Đọc
722
Phan Thế Hiệp
Phan Thế Hiệp
B
Dùng button trên forrm để gọi bàn phím ảo win 10(OSK)
Trả lời
5
Đọc
123
huhumalu
H
P
VẼ ĐƯỜNG TẦN SUẤT (DTS) TRÊN EXCEL
Trả lời
8
Đọc
188
ptm0412
ptm0412
P
GOAL SEEK NÂNG CAO TRONG EXCEL
    • Thích
Trả lời
4
Đọc
199
Hoale85
H
B
Gán Phím Tắt Gọi Form (1 người xem)
Trả lời
7
Đọc
98
HeSanbi
HeSanbi
K
Điền giá trị ô thay vì địa chỉ ô
Trả lời
2
Đọc
126
LOGANWover
L
G
Chia sẻ các bạn File vẽ kèo Zamil từ excel
    • Thích
    • Yêu thích
Trả lời
11
Đọc
910
trqt82
T
T
Xin trợ giúp cách lọc trùng về khoảng thời gian
Trả lời
10
Đọc
2K
Phan Thế Hiệp
Phan Thế Hiệp
L
Xin hàm trích xuất chuỗi trong ô
Trả lời
12
Đọc
207
LINH7979
L
H
[Xin giúp đỡ] Tìm thời gian trùng ở nhiều khoảng thời gian khác nhau.
Trả lời
14
Đọc
2K
Phan Thế Hiệp
Phan Thế Hiệp
N
Thuế thu nhập cá nhân
    • Chấp nhận
Trả lời
3
Đọc
273
ngouyen1505
N
D
Lọc các ô có dữ liệu trùng nhau trong một cột. Xin chỉ giúp
Trả lời
7
Đọc
310
Gà Công Nghệ
Gà Công Nghệ
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom