Tự động chọn vùng và dán kết quả ra vùng mới

[tht2916]

Mong mọi người giúp đỡ. Đây là một hàm vba để kết hợp các giá trị trùng lặp và tính tổng. Nhưng ở đây mỗi lần bấm f5 thì nó yêu cầu mình chọn một dữ liệu sau đó xóa mất đi dữ liệu gốc. MÌnh muốn nhờ các cao nhân sửa hộ cho mình là nó làm sao khi ấn f5 nó sẽ chọn cột A với B là khu vực dữ liệu cần lọc và kết quả sẽ trả về cột D và E . Cảm ơn mọi người nhé

Sub CombineRows()
Updateby Extendoffice
Dim WorkRng As Range
Dim Dic As Variant
Dim arr As Variant
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set Dic = CreateObject("Scripting.Dictionary")
arr = WorkRng.Value
For i = 1 To UBound(arr, 1)
Dic(arr(i, 1)) = Dic(arr(i, 1)) + arr(i, 2)
Next
Application.ScreenUpdating = False
WorkRng.ClearContents
WorkRng.Range("A1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.keys)
WorkRng.Range("B1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.items)
Application.ScreenUpdating = True
End Sub

 

[Hoàng Tuấn 868]

Mong mọi người giúp đỡ. Đây là một hàm vba để kết hợp các giá trị trùng lặp và tính tổng. Nhưng ở đây mỗi lần bấm f5 thì nó yêu cầu mình chọn một dữ liệu sau đó xóa mất đi dữ liệu gốc. MÌnh muốn nhờ các cao nhân sửa hộ cho mình là nó làm sao khi ấn f5 nó sẽ chọn cột A với B là khu vực dữ liệu cần lọc và kết quả sẽ trả về cột D và E . Cảm ơn mọi người nhé

Sub CombineRows()
Updateby Extendoffice
Dim WorkRng As Range
Dim Dic As Variant
Dim arr As Variant
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set Dic = CreateObject("Scripting.Dictionary")
arr = WorkRng.Value
For i = 1 To UBound(arr, 1)
Dic(arr(i, 1)) = Dic(arr(i, 1)) + arr(i, 2)
Next
Application.ScreenUpdating = False
WorkRng.ClearContents
WorkRng.Range("A1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.keys)
WorkRng.Range("B1").Resize(Dic.Count, 1) = Application.WorksheetFunction.Transpose(Dic.items)
Application.ScreenUpdating = True
End Sub

Bạn nên bớt từ cao nhân, thêm file ví dụ và nêu điều kiện lọc cụ thể thì khả năng được hỗ trợ sẽ nhanh hơn nhiều.

Đây là một hàm vba

Đây không phải là một hàm vba bạn nhé.

 

[tht2916]

Bạn nên bớt từ cao nhân, thêm file ví dụ và nêu điều kiện lọc cụ thể thì khả năng được hỗ trợ sẽ nhanh hơn nhiều.

điều kiện là lọc các dữ liệu trùng nhau và tính tổng của các hàng trùng nhau đó thôi. Mình mù về ex quá

 

[Hoàng Tuấn 868]

đó thôi.

Khả năng là ai đó tự bỏ công đi tạo file ví dụ, sau đó sửa code, thử đi thử lại xong đâu đó rồi gửi lại cho bạn chắc chỉ 0,1%.

 

[tht2916]

---

Khả năng là ai đó tự bỏ công đi tạo file ví dụ, sau đó sửa code, thử đi thử lại xong đâu đó rồi gửi lại cho bạn chắc chỉ 0,1%.

bạn làm được hỗ trợ mình với nhé mình cảm ơn

Bài đã được tự động gộp: 1/3/23

Bạn nên bớt từ cao nhân, thêm file ví dụ và nêu điều kiện lọc cụ thể thì khả năng được hỗ trợ sẽ nhanh hơn nhiều.

Đây không phải là một hàm vba bạn nhé.

mình coppy từ trên mạng xuống bạn nhé mình có biết gì về vba đâu