Giúp mình hàm Vba để thay hàm chuổi excel được không ạ?

Liên hệ QC
T

tony008

Thành viên mới
Tham gia
6/10/08
Bài viết
21
Được thích
1
Mình có một danh sách, tên nhà cung cấp, đã dùng hàm chuỗi excel lọc tên trùng và lọc khoảng trắng ra cột L, nhưng nó chạy nặng quá nhiều khi đứng máy luôn. Có anh chị thầy cô giúp mình viết cái code vba để excel chạy bớt nặng được không ạ. Em xin cảm ơn
 

File đính kèm

  • help me.xlsx
    41.3 KB · Đọc: 14
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
Upvote 0
tony008 đã viết:
ok cảm ơn bạn đã nhắc nhở
Nhấp chuột vào đây để mở rộng...
ok là tên của bạn hả?
PHP: 
Option Explicit

Public Sub DanhMuc()
Dim sArr(), dArr(), I As Long, K As Long, R As Long
    sArr = Sheet2.Range("E8", Sheet2.Range("E100000").End(xlUp)).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For I = 1 To R
        If sArr(I, 1) <> Empty Then
            If Not .Exists(sArr(I, 1)) Then
                K = K + 1
                .Item(sArr(I, 1)) = ""
                dArr(K, 1) = sArr(I, 1)
            End If
        End If
    Next I
End With
Sheet2.Range("L8").Resize(R).ClearContents
Sheet2.Range("L8").Resize(K) = dArr
End Sub
 
Upvote 0
Công thức lọc loại trùng, loại rỗng đây.

L8 =IFERROR(INDEX($E$8:$E$1000,AGGREGATE(15,6,ROW($E$1:$E$1000)/($E$8:$E$1000<>"")/(COUNTIF(L$7:L7,$E$8:$E$1000)=0),ROW(G1))),"")

Chỉ enter thôi nhé.
 
Upvote 0
Ba Tê đã viết:
ok là tên của bạn hả?
PHP: 
Option Explicit

Public Sub DanhMuc()
Dim sArr(), dArr(), I As Long, K As Long, R As Long
    sArr = Sheet2.Range("E8", Sheet2.Range("E100000").End(xlUp)).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For I = 1 To R
        If sArr(I, 1) <> Empty Then
            If Not .Exists(sArr(I, 1)) Then
                K = K + 1
                .Item(sArr(I, 1)) = ""
                dArr(K, 1) = sArr(I, 1)
            End If
        End If
    Next I
End With
Sheet2.Range("L8").Resize(R).ClearContents
Sheet2.Range("L8").Resize(K) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
bạn thật vui tính. Cảm ơn bạn nhiều nha
Bài đã được tự động gộp:

Ba Tê đã viết:
ok là tên của bạn hả?
PHP: 
Option Explicit

Public Sub DanhMuc()
Dim sArr(), dArr(), I As Long, K As Long, R As Long
    sArr = Sheet2.Range("E8", Sheet2.Range("E100000").End(xlUp)).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For I = 1 To R
        If sArr(I, 1) <> Empty Then
            If Not .Exists(sArr(I, 1)) Then
                K = K + 1
                .Item(sArr(I, 1)) = ""
                dArr(K, 1) = sArr(I, 1)
            End If
        End If
    Next I
End With
Sheet2.Range("L8").Resize(R).ClearContents
Sheet2.Range("L8").Resize(K) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
nếu cột "tên nhà cung cấp" cột E8 mà mình nhập thêm tên vào thì nó không tự động hiện bên cột L ah bạn hay là mình phải chạy lại từ đầu ạ
 
Lần chỉnh sửa cuối:
Upvote 0
tony008 đã viết:
bạn thật vui tính. Cảm ơn bạn nhiều nha
Bài đã được tự động gộp:


nếu cột "tên nhà cung cấp" cột E8 mà mình nhập thêm tên vào thì nó không tự động hiện bên cột L ah bạn hay là mình phải chạy lại từ đầu ạ
Nhấp chuột vào đây để mở rộng...
Mỗi lần "đụng chạm" vào cột E mà "chạy" 1 lần thì có "phí của" lắm không?
 

File đính kèm

  • help me.xlsm
    47.9 KB · Đọc: 4
Upvote 0
tony008 đã viết:
nếu cột "tên nhà cung cấp" cột E8 mà mình nhập thêm tên vào thì nó không tự động hiện bên cột L ah bạn hay là mình phải chạy lại từ đầu ạ
Nhấp chuột vào đây để mở rộng...
Sau khi thêm, phải chạy lại sub.
Mã: 
Sub Macro1()

    Dim lastRow As Long
    lastRow = Range("E" & Rows.Count).End(xlUp).Row
    Range("E8:E" & lastRow).Copy Range("L8")
    Range("L8:L" & lastRow).RemoveDuplicates Columns:=1, Header:=xlNo
    Range("L8:L" & lastRow).Sort Key1:=Range("L8"), Order1:=xlAscending, Header:=xlNo
End Sub
 
Upvote 0
Ba Tê đã viết:
Mỗi lần "đụng chạm" vào cột E mà "chạy" 1 lần thì có "phí của" lắm không?
Nhấp chuột vào đây để mở rộng...
cảm ơn bạn rất nhiều, bạn có thể giúp mình thêm 1 bước sắp sếp tên lọc ra theo thứ tự A,B,C không vậy.Mình không rành lênh VBA lắm, cảm ơn bạn nhiều
Bài đã được tự động gộp:

phuocam đã viết:
Sau khi thêm, phải chạy lại sub.
Mã: 
Sub Macro1()

    Dim lastRow As Long
    lastRow = Range("E" & Rows.Count).End(xlUp).Row
    Range("E8:E" & lastRow).Copy Range("L8")
    Range("L8:L" & lastRow).RemoveDuplicates Columns:=1, Header:=xlNo
    Range("L8:L" & lastRow).Sort Key1:=Range("L8"), Order1:=xlAscending, Header:=xlNo
End Sub
Nhấp chuột vào đây để mở rộng...
code của bạn có cần chạy lại không hay là tự động ra luôn ạ
Bài đã được tự động gộp:

phuocam đã viết:
Sau khi thêm, phải chạy lại sub.
Mã: 
Sub Macro1()

    Dim lastRow As Long
    lastRow = Range("E" & Rows.Count).End(xlUp).Row
    Range("E8:E" & lastRow).Copy Range("L8")
    Range("L8:L" & lastRow).RemoveDuplicates Columns:=1, Header:=xlNo
    Range("L8:L" & lastRow).Sort Key1:=Range("L8"), Order1:=xlAscending, Header:=xlNo
End Sub
Nhấp chuột vào đây để mở rộng...
code của bạn có cần chạy lại không hay là tự động ra luôn ạ
 
Upvote 0
tony008 đã viết:
cảm ơn bạn rất nhiều, bạn có thể giúp mình thêm 1 bước sắp sếp tên lọc ra theo thứ tự A,B,C không vậy.Mình không rành lênh VBA lắm, cảm ơn bạn nhiều
Nhấp chuột vào đây để mở rộng...
Thay Sub cũ trong Module bằng cái này:
PHP: 
Option Explicit

Public Sub DanhMuc()
Application.ScreenUpdating = False
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Txt As String
    sArr = Sheet2.Range("E8", Sheet2.Range("E100000").End(xlUp)).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For I = 1 To R
        If sArr(I, 1) <> Empty Then
            Txt = Application.WorksheetFunction.Trim(sArr(I, 1))
            If Not .Exists(Txt) Then
                K = K + 1
                .Item(Txt) = ""
                dArr(K, 1) = Application.WorksheetFunction.Proper(Txt)
            End If
        End If
    Next I
End With
With Sheet2
    .Range("L8").Resize(R).ClearContents
    .Range("L8").Resize(K) = dArr
    .Range("L8").Resize(K).Sort Key1:=.Range("L8"), Order1:=xlAscending
End With
End Sub
 
Upvote 0
Ba Tê đã viết:
Thay Sub cũ trong Module bằng cái này:
PHP: 
Option Explicit

Public Sub DanhMuc()
Application.ScreenUpdating = False
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Txt As String
    sArr = Sheet2.Range("E8", Sheet2.Range("E100000").End(xlUp)).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For I = 1 To R
        If sArr(I, 1) <> Empty Then
            Txt = Application.WorksheetFunction.Trim(sArr(I, 1))
            If Not .Exists(Txt) Then
                K = K + 1
                .Item(Txt) = ""
                dArr(K, 1) = Application.WorksheetFunction.Proper(Txt)
            End If
        End If
    Next I
End With
With Sheet2
    .Range("L8").Resize(R).ClearContents
    .Range("L8").Resize(K) = dArr
    .Range("L8").Resize(K).Sort Key1:=.Range("L8"), Order1:=xlAscending
End With
End Sub
Nhấp chuột vào đây để mở rộng...
cảm ơn bạn rất nhiều.
 
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

nguyenphuochien166
Cách Vlookup hoặc cách lấy thông tin dữ liệu có dấu mũ lũy thừa?
    • Cười
Trả lời
4
Đọc
42
Hoàng Tuấn 868
H
C
Chia sẻ: Kết quả xổ số Keno
    • Thích
    • Cười
Trả lời
6
Đọc
167
SA_DQ
SA_DQ
Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
24
Đọc
474
SA_DQ
SA_DQ
B
Lọc dữ liệu trùng, đếm số lần, tự tô màu theo điều kiện.
Trả lời
3
Đọc
88
batista911
B
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
12
Đọc
212
ptm0412
ptm0412
C
Công thức tự nhập liệu số lượng nhập khi bị âm
Trả lời
1
Đọc
70
hoangtuaotrang_hp_vn
H
kimtanmap
  • Question
Nhờ viết code VBA Macro lập lại.
Trả lời
5
Đọc
130
kimtanmap
kimtanmap
dung09031989
Xin giúp công thức tô màu các ô phía sau khi kế hoạch đặt hàng thiếu so với tồn kho.?
Trả lời
1
Đọc
67
hoangtuaotrang_hp_vn
H
huynhnhu1234
Tìm giá vé máy bay một chiều và khứ hồi
Trả lời
0
Đọc
39
huynhnhu1234
huynhnhu1234
V
[Nhờ giúp đỡ] Cách tìm thời gian bị trùng trong excel ở nhiều thời gian khác nhau
Trả lời
7
Đọc
121
tranvansau278
T
N
Hàm tìm giá trị theo giờ vào - ra
Trả lời
6
Đọc
111
Nguyễn Linh hn94
N
zarra
Cần giúp tạo form in mã vạch cho vật tư theo SL cụ thể.
Trả lời
4
Đọc
155
zarra
zarra
Nguyễn Duy Tuân
  • Question
Chia sẻ ControlForOffice - Bộ công cụ điều khiển Office/Excel
    • Thích
6 7 8
Trả lời
148
Đọc
95K
leminhksvl
L
HeSanbi
  • Question
Lỗi VBA: Cài đặt thông số ForceVBALoadFromSource trong Registry để VBA biên dịch không bị lỗi
    • Cảm ơn
    • Thích
Trả lời
5
Đọc
288
anhdepjai
A
H
Hàm đếm số ngày thứ bảy và chủ nhật trong một khoảng thời gian
Trả lời
18
Đọc
20K
DeTong
D
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
11 12 13
Trả lời
245
Đọc
13K
Hoàng Trọng Hữu
Hoàng Trọng Hữu
D
  • Question
Xin cách sắp xếp dữ liệu theo thứ tự không làm hỏng link
Trả lời
7
Đọc
302
cantl
C
N
Giúp sửa mã code
Trả lời
16
Đọc
280
ptm0412
ptm0412
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
1
Đọc
64
hoangminhtien
hoangminhtien
GPE-Trợ Lý
KHÓA HỌC BỨT PHÁ KỸ NĂNG EXCEL
    • Thích
Trả lời
0
Đọc
199
GPE-Trợ Lý
GPE-Trợ Lý
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

Back
Top Bottom