Chuyển đổi hàm thành UDF

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
H

hiennv.tsc

Thành viên mới
Tham gia
13/4/19
Bài viết
48
Được thích
16
Mình có file dữ liệu bằng hàm Excel như này, kính nhờ các bạn trên diễn đàn viết giúp thành hàm UDF.
Kính mong các bạn giúp đỡ.
Xin trân thành cảm ơn!
 

File đính kèm

  • Chuyển hàm thành UDF_3.xlsb
    28.8 KB · Đọc: 9
Sắp xếp theo thời gian sắp xếp theo bầu chọn
hiennv.tsc đã viết:
Mình có file dữ liệu bằng hàm Excel như này, kính nhờ các bạn trên diễn đàn viết giúp thành hàm UDF.
Kính mong các bạn giúp đỡ.
Xin trân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
Mã: 
Function DemBua_DungThiDung_KhongDungThiDung(strSou As String, _
                                            deli As String, _
                                            rng As Range) As String
    Dim arrSou, arrcomp, arrCount
    Dim i As Long, j As Long, k As Long, tmp1 As String, tmp2 As Long
    Dim str As String
   
    arrcomp = rng
    arrSou = Split(strSou, deli)
    ReDim arrCount(1 To rng.Columns.Count, 1 To 2)
   
    'Dem so lan xuat hien
    For i = 1 To rng.Columns.Count
        arrCount(i, 1) = arrcomp(1, i)
        k = 0
        For j = LBound(arrSou) To UBound(arrSou)
            If arrcomp(1, i) = arrSou(j) Then
            k = k + 1
            End If
        Next j
        arrCount(i, 2) = k
    Next

    'Sap xem lai mang - phuong phap noi bot

    For i = 1 To UBound(arrCount)
        For j = i + 1 To UBound(arrCount)
            If arrCount(i, 2) < arrCount(j, 2) Then
                ' Hoan doi gia tri cua hang i và j
                tmp1 = arrCount(i, 1)
                arrCount(i, 1) = arrCount(j, 1)
                arrCount(j, 1) = tmp1
                tmp2 = arrCount(i, 2)
                arrCount(i, 2) = arrCount(j, 2)
                arrCount(j, 2) = tmp2
            End If
        Next j
    Next i
    'Noi ket qua
    For i = 1 To UBound(arrCount)
        str = str & deli & arrCount(i, 1)
    Next i
    str = Right(str, Len(str) - Len(deli))
    DemBua_DungThiDung_KhongDungThiDung = str
End Function
Chú ý giá trị từ ô I17 đến AB17 đã chuyển từ kiểu number sang kiểu string. Bác định dạng 5 cột đầu thì là kiểu string 20 cột sau thì định dạng kiểu Number làm ra kết quả không khớp dò mệt nghỉ lỗi sai. Ở ô AD29 gõ hàm =DemBua_DungThiDung_KhongDungThiDung(E4&","&H4;",";D$17:AB$17)
 
Upvote 0
Mr.hieudoanxd đã viết:
Mã: 
Function DemBua_DungThiDung_KhongDungThiDung(strSou As String, _
                                            deli As String, _
                                            rng As Range) As String
    Dim arrSou, arrcomp, arrCount
    Dim i As Long, j As Long, k As Long, tmp1 As String, tmp2 As Long
    Dim str As String
  
    arrcomp = rng
    arrSou = Split(strSou, deli)
    ReDim arrCount(1 To rng.Columns.Count, 1 To 2)
  
    'Dem so lan xuat hien
    For i = 1 To rng.Columns.Count
        arrCount(i, 1) = arrcomp(1, i)
        k = 0
        For j = LBound(arrSou) To UBound(arrSou)
            If arrcomp(1, i) = arrSou(j) Then
            k = k + 1
            End If
        Next j
        arrCount(i, 2) = k
    Next

    'Sap xem lai mang - phuong phap noi bot

    For i = 1 To UBound(arrCount)
        For j = i + 1 To UBound(arrCount)
            If arrCount(i, 2) < arrCount(j, 2) Then
                ' Hoan doi gia tri cua hang i và j
                tmp1 = arrCount(i, 1)
                arrCount(i, 1) = arrCount(j, 1)
                arrCount(j, 1) = tmp1
                tmp2 = arrCount(i, 2)
                arrCount(i, 2) = arrCount(j, 2)
                arrCount(j, 2) = tmp2
            End If
        Next j
    Next i
    'Noi ket qua
    For i = 1 To UBound(arrCount)
        str = str & deli & arrCount(i, 1)
    Next i
    str = Right(str, Len(str) - Len(deli))
    DemBua_DungThiDung_KhongDungThiDung = str
End Function
Chú ý giá trị từ ô I17 đến AB17 đã chuyển từ kiểu number sang kiểu string. Bác định dạng 5 cột đầu thì là kiểu string 20 cột sau thì định dạng kiểu Number làm ra kết quả không khớp dò mệt nghỉ lỗi sai. Ở ô AD29 gõ hàm =DemBua_DungThiDung_KhongDungThiDung(E4&","&H4;",";D$17:AB$17)
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn rất nhiều.
Lỗi đó là do mình (Đáng nhẽ tất cả là dạng Text nhưng mình làm bị sai sót)
Mình đang kiểm tra (Có khả năng là rất đúng nhưng mình đang ngờ ngợ có chút bị lỗi)
Có gì chưa đúng mong bạn chỉnh sửa code giúp mình nhé.
Mình có đánh dấu mấy chỗ trong file bạn chỉnh sửa giúp mình nhé.
 

File đính kèm

  • Chuyển hàm thành UDF_3.xlsb
    33.4 KB · Đọc: 2
Upvote 0
hiennv.tsc đã viết:
Cảm ơn bạn rất nhiều.
Lỗi đó là do mình (Đáng nhẽ tất cả là dạng Text nhưng mình làm bị sai sót)
Mình đang kiểm tra (Có khả năng là rất đúng nhưng mình đang ngờ ngợ có chút bị lỗi)
Có gì chưa đúng mong bạn chỉnh sửa code giúp mình nhé.
Mình có đánh dấu mấy chỗ trong file bạn chỉnh sửa giúp mình nhé.
Nhấp chuột vào đây để mở rộng...
Đã kiểm tra như lời bác nói- thêm hàm tách chữ theo ký tự nối là"," sau đó ra các cột ở dưới, đồng thời do ngược lại bằng HLOOKUP ở bảng bên trên để xem giá trị đếm có được sắp xếp đúng không. Chưa hiểu ý bác là sai chỗ nào
 

File đính kèm

  • Chuyển hàm thành UDF_3_Check.xlsb
    38.5 KB · Đọc: 3
Upvote 0
Mr.hieudoanxd đã viết:
Đã kiểm tra như lời bác nói- thêm hàm tách chữ theo ký tự nối là"," sau đó ra các cột ở dưới, đồng thời do ngược lại bằng HLOOKUP ở bảng bên trên để xem giá trị đếm có được sắp xếp đúng không. Chưa hiểu ý bác là sai chỗ nào
Nhấp chuột vào đây để mở rộng...
Bạn ơi, ý của mình đã trình bày lại trong file. Bạn sửa code giúp mình với nhé bạn.
Cảm ơn bạn.
 

File đính kèm

  • Chuyển hàm thành UDF_3_Check.xlsb
    37.5 KB · Đọc: 5
Upvote 0
hiennv.tsc đã viết:
Bạn ơi, ý của mình đã trình bày lại trong file. Bạn sửa code giúp mình với nhé bạn.
Cảm ơn bạn.
Nhấp chuột vào đây để mở rộng...
Tưởng xong rồi chứ quay lại diễn đàn thấy vẫn còn. Bác sửa lại theo code này
Mã: 
Function DemBua_DungThiDung_KhongDungThiDung(strSou As String, _
                                            deli As String, _
                                            rng As Range) As String
    Dim arrSou, arrcomp, arrCount
    Dim i As Long, j As Long, k As Long, tmp1 As String, tmp2 As Long
    Dim str As String
    
    arrcomp = rng
    arrSou = Split(strSou, deli)
    ReDim arrCount(1 To rng.Columns.Count, 1 To 2)
    
    'Dem so lan xuat hien
    For i = 1 To rng.Columns.Count
        arrCount(i, 1) = arrcomp(1, i)
        k = 0
        For j = LBound(arrSou) To UBound(arrSou)
            If arrcomp(1, i) = arrSou(j) Then
            k = k + 1
            End If
        Next j
        arrCount(i, 2) = k
    Next

    'Sap xep lai mang - phuong phap noi bot

    For i = 1 To UBound(arrCount)
        For j = i + 1 To UBound(arrCount)
            'Sap xep Nhieu xuong it
            If arrCount(i, 2) < arrCount(j, 2) Then
                ' Hoan doi gia tri cua hang i và j
                tmp1 = arrCount(i, 1)
                arrCount(i, 1) = arrCount(j, 1)
                arrCount(j, 1) = tmp1
                tmp2 = arrCount(i, 2)
                arrCount(i, 2) = arrCount(j, 2)
                arrCount(j, 2) = tmp2
            End If
            'Sap xep lon ve nho
            If arrCount(i, 2) = arrCount(j, 2) And CLng(arrCount(i, 1)) < CLng(arrCount(j, 1)) Then
                ' Hoan doi gia tri cua hang i và j
                tmp1 = arrCount(i, 1)
                arrCount(i, 1) = arrCount(j, 1)
                arrCount(j, 1) = tmp1
                tmp2 = arrCount(i, 2)
                arrCount(i, 2) = arrCount(j, 2)
                arrCount(j, 2) = tmp2
            End If
        Next j
    Next i
    'Sap xep lai mang  - lan 2
    
    'Noi ket qua
    For i = 1 To UBound(arrCount)
        str = str & deli & arrCount(i, 1)
    Next i
    str = Right(str, Len(str) - Len(deli))
    DemBua_DungThiDung_KhongDungThiDung = str
End Function
 
Upvote 0
Mr.hieudoanxd đã viết:
Tưởng xong rồi chứ quay lại diễn đàn thấy vẫn còn. Bác sửa lại theo code này
Mã: 
Function DemBua_DungThiDung_KhongDungThiDung(strSou As String, _
                                            deli As String, _
                                            rng As Range) As String
    Dim arrSou, arrcomp, arrCount
    Dim i As Long, j As Long, k As Long, tmp1 As String, tmp2 As Long
    Dim str As String
   
    arrcomp = rng
    arrSou = Split(strSou, deli)
    ReDim arrCount(1 To rng.Columns.Count, 1 To 2)
   
    'Dem so lan xuat hien
    For i = 1 To rng.Columns.Count
        arrCount(i, 1) = arrcomp(1, i)
        k = 0
        For j = LBound(arrSou) To UBound(arrSou)
            If arrcomp(1, i) = arrSou(j) Then
            k = k + 1
            End If
        Next j
        arrCount(i, 2) = k
    Next

    'Sap xep lai mang - phuong phap noi bot

    For i = 1 To UBound(arrCount)
        For j = i + 1 To UBound(arrCount)
            'Sap xep Nhieu xuong it
            If arrCount(i, 2) < arrCount(j, 2) Then
                ' Hoan doi gia tri cua hang i và j
                tmp1 = arrCount(i, 1)
                arrCount(i, 1) = arrCount(j, 1)
                arrCount(j, 1) = tmp1
                tmp2 = arrCount(i, 2)
                arrCount(i, 2) = arrCount(j, 2)
                arrCount(j, 2) = tmp2
            End If
            'Sap xep lon ve nho
            If arrCount(i, 2) = arrCount(j, 2) And CLng(arrCount(i, 1)) < CLng(arrCount(j, 1)) Then
                ' Hoan doi gia tri cua hang i và j
                tmp1 = arrCount(i, 1)
                arrCount(i, 1) = arrCount(j, 1)
                arrCount(j, 1) = tmp1
                tmp2 = arrCount(i, 2)
                arrCount(i, 2) = arrCount(j, 2)
                arrCount(j, 2) = tmp2
            End If
        Next j
    Next i
    'Sap xep lai mang  - lan 2
   
    'Noi ket qua
    For i = 1 To UBound(arrCount)
        str = str & deli & arrCount(i, 1)
    Next i
    str = Right(str, Len(str) - Len(deli))
    DemBua_DungThiDung_KhongDungThiDung = str
End Function
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn @Mr.hieudoanxd rất nhiều.
Hàm rất chuẩn và linh hoạt.
Không biết nói gì hơn, mình chúc bạn luôn vui vẻ và thành đạt trong tất cả các công việc.
 
Upvote 0
Mr.hieudoanxd đã viết:
Tưởng xong rồi chứ quay lại diễn đàn thấy vẫn còn. Bác sửa lại theo code này
Mã: 
Function DemBua_DungThiDung_KhongDungThiDung(strSou As String, _
                                            deli As String, _
                                            rng As Range) As String
    Dim arrSou, arrcomp, arrCount
    Dim i As Long, j As Long, k As Long, tmp1 As String, tmp2 As Long
    Dim str As String
   
    arrcomp = rng
    arrSou = Split(strSou, deli)
    ReDim arrCount(1 To rng.Columns.Count, 1 To 2)
   
    'Dem so lan xuat hien
    For i = 1 To rng.Columns.Count
        arrCount(i, 1) = arrcomp(1, i)
        k = 0
        For j = LBound(arrSou) To UBound(arrSou)
            If arrcomp(1, i) = arrSou(j) Then
            k = k + 1
            End If
        Next j
        arrCount(i, 2) = k
    Next

    'Sap xep lai mang - phuong phap noi bot

    For i = 1 To UBound(arrCount)
        For j = i + 1 To UBound(arrCount)
            'Sap xep Nhieu xuong it
            If arrCount(i, 2) < arrCount(j, 2) Then
                ' Hoan doi gia tri cua hang i và j
                tmp1 = arrCount(i, 1)
                arrCount(i, 1) = arrCount(j, 1)
                arrCount(j, 1) = tmp1
                tmp2 = arrCount(i, 2)
                arrCount(i, 2) = arrCount(j, 2)
                arrCount(j, 2) = tmp2
            End If
            'Sap xep lon ve nho
            If arrCount(i, 2) = arrCount(j, 2) And CLng(arrCount(i, 1)) < CLng(arrCount(j, 1)) Then
                ' Hoan doi gia tri cua hang i và j
                tmp1 = arrCount(i, 1)
                arrCount(i, 1) = arrCount(j, 1)
                arrCount(j, 1) = tmp1
                tmp2 = arrCount(i, 2)
                arrCount(i, 2) = arrCount(j, 2)
                arrCount(j, 2) = tmp2
            End If
        Next j
    Next i
    'Sap xep lai mang  - lan 2
   
    'Noi ket qua
    For i = 1 To UBound(arrCount)
        str = str & deli & arrCount(i, 1)
    Next i
    str = Right(str, Len(str) - Len(deli))
    DemBua_DungThiDung_KhongDungThiDung = str
End Function
Nhấp chuột vào đây để mở rộng...
Em nhờ chủ đề của chủ thớt với nhé.
Anh oi, nếu bây giờ dữ liệu đầu vào có các ký tự (3 dấu phân cách) là: (,) và (;) và (_) thì điều chỉnh hàm như nào hở anh?
Em nhờ anh @Mr.hieudoanxd và các anh chị cùng các bác hướng dẫn em chỉnh sửa hàm này với ạ.
 

File đính kèm

  • Chuyển hàm thành UDF_3_Check.xlsb
    37.1 KB · Đọc: 5
Upvote 0
hongphuong1997 đã viết:
nếu bây giờ dữ liệu đầu vào có các ký tự (3 dấu phân cách) là: (,) và (;) và (_) thì điều chỉnh hàm như nào hở anh?
Nhấp chuột vào đây để mở rộng...
Em thử tìm cách thay thế các dấu kia thành dấu phẩy "," xem thế nào. Một là thay thế trong code, hai là lồng thêm hàm Subtitute vào.
 
Upvote 0
hongphuong1997 đã viết:
Em nhờ chủ đề của chủ thớt với nhé.
Anh oi, nếu bây giờ dữ liệu đầu vào có các ký tự (3 dấu phân cách) là: (,) và (;) và (_) thì điều chỉnh hàm như nào hở anh?
Em nhờ anh @Mr.hieudoanxd và các anh chị cùng các bác hướng dẫn em chỉnh sửa hàm này với ạ.
Nhấp chuột vào đây để mở rộng...
Ủa mình đã trợ giúp cho bạn ở Inbox rồi mà??? công thức ở ô K11
 

File đính kèm

  • Chuyển hàm thành UDF_3_Check_Hoi Cham.xlsb
    42.5 KB · Đọc: 1
Upvote 0
Hoàng Tuấn 868 đã viết:
Em thử tìm cách thay thế các dấu kia thành dấu phẩy "," xem thế nào. Một là thay thế trong code, hai là lồng thêm hàm Subtitute vào.
Nhấp chuột vào đây để mở rộng...
Em muốn thay đổi trong code cơ anh oi.
Vì em muốn các anh chị chỉnh sửa trong code cho em để em học hỏi và biết cách vận dụng cho các trường hợp khác nhau ạ.
Anh làm và hướng dẫn em với anh nhé.
 
Upvote 0
Mr.hieudoanxd đã viết:
Ủa mình đã trợ giúp cho bạn ở Inbox rồi mà??? công thức ở ô K11
Nhấp chuột vào đây để mở rộng...
Hihi em cảm ơn anh ạ.
Nhưng em thích cái hàm ở bài #6 của anh cơ (Chứ không phải à tách ra như vậy đâu anh oi)
www.giaiphapexcel.com

Chuyển đổi hàm thành UDF

Mình có file dữ liệu bằng hàm Excel như này, kính nhờ các bạn trên diễn đàn viết giúp thành hàm UDF. Kính mong các bạn giúp đỡ. Xin trân thành cảm ơn!
www.giaiphapexcel.com www.giaiphapexcel.com
Anh chỉnh lại code của bài #6 cho em với ạ.
Em cảm ơn anh ạ.
Bài đã được tự động gộp:

Hoàng Tuấn 868 đã viết:
Có chính chủ rồi đó em.
Nhấp chuột vào đây để mở rộng...
Anh hướng dẫn em với ạ, mỗi người mỗi cách thì em càng học đực nhiều anh oi.
Anh làm cho em với nhé anh.
Em cảm ơn anh ạ.
 
Upvote 0

File đính kèm

  • Chuyển hàm thành UDF_3_Check_Hoi Cham.xlsb
    44.1 KB · Đọc: 2
Upvote 0
Mr.hieudoanxd đã viết:
Mình chỉnh code trong file sửa lại tham số 1 chút. Code trước mình đã gửi hàm SplitText2 kết quả trả về mảng để bạn vận dụng là ra rồi bạn thêm vào là xong mà
Nhấp chuột vào đây để mở rộng...
Em cảm ơn anh ạ
Hihi... thật sự là em rất ngu về VBA em nghiên cứu mãi mừ đầu óc vẫn củ chuối lắm anh oi.
Bài đã được tự động gộp:

Hoàng Tuấn 868 đã viết:
Câu này em có nói thật lòng không đấy.
Nhấp chuột vào đây để mở rộng...
Huhu.....bàn phím máy của em bị kẹt nên bị thiếu đóa anh oi.
 
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

Bùi Đức Dương
Vba sang Vb.net
Trả lời
4
Đọc
102
VetMini
V
LuuAnh980
Vấn đề viết tắt trong Diễn Đàn.
    • Thích
    • Cười
2 3
Trả lời
46
Đọc
954
SA_DQ
SA_DQ
ann266
Kế toán kho F&B
    • Cười
2
Trả lời
27
Đọc
412
ann266
ann266
H
Tính tổng có điều kiện
    • Thích
2
Trả lời
24
Đọc
571
hoaiantrinh
H
ptm0412
Hàm XLOOKUP: Có thể bạn chưa biết hết tính năng và ứng dụng
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
2
Đọc
9K
dinhhuykbbl
dinhhuykbbl
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