Tập hợp HÀM TỰ TẠO để làm thư viện Hàm (1 người xem)

Liên hệ QC

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

Ếch Xanh

Thành viên tích cực
Tham gia
12/8/09
Bài viết
865
Được thích
1,573
Topic này tôi mở ra mục đích là tập hợp những hàm tự tạo hay của diễn đàn, để về sau nếu ai có khả năng tổng hợp thành Addins toàn tập thì dễ dàng lấy nguồn tại đây.

Tôi cũng hy vọng, các thành viên nào có những hàm hay hoặc thấy những hàm hay trên diễn đàn Giải pháp Excel hoặc diễn đàn khác, xin vui lòng post lên đây, và vui lòng trích nguồn từ link nào để tiện theo dõi.

Bài viết này, với tôi trình độ còn yếu kém, cho nên cách đặt tên hàm cũng như cách sử dụng hàm cũng chưa chính xác, vậy xin các thành viên bổ sung, góp ý, phản biện để các hàm của chúng ta trở nên mạnh hơn, hiệu quả hơn, chất lượng hơn, nhanh hơn đặc biệt chính xác hơn.

THAM KHẢO THÊM: Mỗi ngày một hàm VBA tại đây:
http://www.giaiphapexcel.com/forum/showthread.php?31-Mỗi-tuần-một-hàm-VBA&

Dưới đây là mở đầu một vài hàm:

1) Hàm Thay đổi kích thước mảng 2 chiều (ptm0412)

PHP:
Function resizeArr(ByVal SourceArr, ByVal NewC As Long)
  Dim OldR As Long, OldC As Long, NewR As Long, iR As Long, iC As Long
  Dim ArrKQ, iKQ, jKQ, SArr
  SArr = SourceArr
  iKQ = 1: jKQ = 1
  OldR = UBound(SArr, 1)
  OldC = UBound(SArr, 2)
  NewR = Int(OldR * OldC / NewC)
  If (OldR * OldC) Mod NewC > 0 Then NewR = NewR + 1
  ReDim ArrKQ(1 To NewR, 1 To NewC)
  For iC = 1 To OldC
    For iR = 1 To OldR
      ArrKQ(iKQ, jKQ) = SArr(iR, iC)
      iKQ = iKQ + 1
      If iKQ > NewR Then iKQ = 1: jKQ = jKQ + 1
    Next
  Next
  resizeArr = ArrKQ
End Function

Nguồn: http://www.giaiphapexcel.com/forum/...về-mảng-trong-VBA-(Array)&p=309679#post309679

-------------------------------------------------------------------------------


2) Hàm SORT mảng 1 chiều: (ndu96081631)

PHP:
Function Sort1DArray(ByVal Arr, Optional ByVal isText As Boolean = False, Optional ByVal isDESC As Boolean = False)
  Dim sCommand As String
  sCommand = "('" & Join(Arr, vbBack) & "').split('" & vbBack & "').sort("
  If isText Then
    sCommand = sCommand & ")"
  Else
    sCommand = sCommand & "function(a,b){return (a-b)})"
  End If
  If isDESC Then sCommand = sCommand & ".reverse()"
    sCommand = sCommand & ".join('" & vbBack & "')"
  With CreateObject("MSScriptControl.ScriptControl")
    .Language = "JavaScript"
    Sort1DArray = Split(.Eval(sCommand), vbBack)
  End With
End Function


Nguồn: http://www.giaiphapexcel.com/forum/...về-mảng-trong-VBA-(Array)&p=320811#post320811

-------------------------------------------------------------------------------

3) Hàm tính diện tích tam giác (ndu96081631)

PHP:
Function TriArea(ByVal x1 As Double, ByVal x2 As Double, ByVal x3 As Double, _
                 ByVal y1 As Double, ByVal y2 As Double, ByVal y3 As Double) As Double
  Dim dA As Double, dB As Double, dC As Double, dP As Double
  dA = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2) '<--- Chieu dai canh A
  dB = Sqr((x3 - x2) ^ 2 + (y3 - y2) ^ 2) '<--- Chieu dai canh B
  dC = Sqr((x1 - x3) ^ 2 + (y1 - y3) ^ 2) '<--- Chieu dai canh C
  dP = (dA + dB + dC) / 2 '<--- nua chu vi
  TriArea = Sqr(dP * (dP - dA) * (dP - dB) * (dP - dC))
End Function

Nguồn: http://www.giaiphapexcel.com/forum/...khi-biết-toạ-độ-trên-exel&p=319887#post319887

CÒN TIẾP, SẼ BỔ SUNG SAU...
 
Lần chỉnh sửa cuối:
Upvote 0
Hôm trước tôi có gữi nguyên thư mục Excel lên mediafire. Tải về, tìm trong thư mục Excel\LearnVBA\UDF sẽ có cả đống

Của Thầy thì có sẳn đó thì từ từ sẽ tập hợp sau, còn những hàm của những cao thủ rãi rác khắp diễn đàn thì gom lại khó hơn Thầy ạ!

Các thành viên ơi, ai có hàm hay hoặc thấy được hàm hay thì post vô đây nhé!
 
Upvote 0
Hàm này trung bình cộng theo màu của background chẳng nhớ của ai trên diễn đàn.
PHP:
Function TBCONGMAU(VungDL, OMau)
Dim Tong, OHT, MauHT, MauChuan, dem, KQ
'L?y màu chu?n
MauChuan = OMau.Font.Color
'X? lý t?ng ô m?t trong vùng
For Each OHT In VungDL
'L?y màu c?a ô hi?n t?i
MauHT = OHT.Font.Color
'N?u là ô s? có màu ch? trùng màu thì c?ng vào bi?n tong, và tang bi?n dem
If IsNumeric(OHT) And (MauHT = MauChuan) Then
Tong = Tong + OHT
dem = dem + 1
End If
Next
If dem = 0 Then
KQ = "Không có ô nào trùng màu ô m?u"
Else
KQ = Tong / dem
End If
TBCONGMAU = KQ
End Function
 
Upvote 0
Hàm chữ hoa và chữ thường sử dụng phím tắt Ctrl+Shift+T; Ctrl+Shift+H; Ctrl+Shift+K của một mem trên diễn đàn.
 

File đính kèm

Upvote 0
Kính gởi Learning_Excel, Anh Tuấn,

Em cũng muốn đưa những hàm này vào thư viện, nhưng xin các bạn hãy phân tích, so sánh và chọn lọc trước khi đưa vào. Như vậy thư viện mới chất lượng được.
Hoặc nếu thấy trong thư viện có gì sai thì cũng xin thông báo.

Tks,

Lê Văn Duyệt
 
Upvote 0
Kính gởi Learning_Excel, Anh Tuấn,

Em cũng muốn đưa những hàm này vào thư viện, nhưng xin các bạn hãy phân tích, so sánh và chọn lọc trước khi đưa vào. Như vậy thư viện mới chất lượng được.
Hoặc nếu thấy trong thư viện có gì sai thì cũng xin thông báo.

Tks,

Lê Văn Duyệt
Vậy thì Duyệt tham gia đi ---> Mấy vụ này tôi... lười lắm
 
Upvote 0
Nên chăng Ếch xanh cũng nên tham khảo cách fân loại như các hàm trong Excel để làm.

& có thể có thêm những đặc thù mà trong Excel chưa thể có được;
 
Upvote 0
Góp vui với diễn đàn hàm tính giai thừa nho nhỏ nha hi hi

Function giaithua(n As Integer) As Long
If (n <= 0) Then
Exit Function
End If
If (n > 1) Then
giaithua= n * giaithua(n - 1)
Else
giaithua= 1
End If
End Function

em không hiểu tại sao em trình bày thục vào thục ra mà khi đưa lên diễn đàn nó của thằng băng em không hiểu
 
Lần chỉnh sửa cuối:
Upvote 0
Góp vui với diễn đàng hàm tính lũy thừa nho nhỏ nha hi hi

Function Luythua(n As Integer) As Long
If (n <= 0) Then
Exit Function
End If
If (n > 1) Then
Luythua = n * Luythua(n - 1)
Else
Luythua = 1
End If
End Function
Cái này là GIAI THỪA chứ LŨY THỪA gì chứ
Mà giai thừa thì trong Excel có rồi, cần gì phải tạo hàm
Ở đây cần tập hợp những hàm cần thiết mà chưa có trong Excel cơ
 
Upvote 0
Không biết là trong diễn đàn có hàm tìm số nguyên tố nào không?
tui xin góp một hàm tìm số nguyên tố cơ bản nhất, tuy là chạy thuộc loại lâu nhất(cùi bắp nhất) nhưng mà dễ hiểu nhất
vì theo như định nghĩa toán học, một số nguyên dương mà có đúng 2 ước là số nguyên tô

Function Isprime_number(n As Long) As Boolean
Dim dem_uoc As Integer
Dim i As Long
dem_uoc = 0
For i = 1 To n
If (n Mod i = 0) Then
demuoc = demuoc + 1
End If
Next i
If (demuoc = 2) Then
Isprime_number = True
Else
Isprime_number = False
End If
End Function
 
Upvote 0
Không biết là trong diễn đàn có hàm tìm số nguyên tố nào không?
tui xin góp một hàm tìm số nguyên tố cơ bản nhất, tuy là chạy thuộc loại lâu nhất(cùi bắp nhất) nhưng mà dễ hiểu nhất
vì theo như định nghĩa toán học, một số nguyên dương mà có đúng 2 ước là số nguyên tô
Cái dzà... mấy cái này có từ đời nào rồi ---> Code của bạn đúng là cho tốc độ rất chậm đấy
Ít ra cũng phải vầy:
PHP:
Function Isprime_number(n As Long) As Boolean
  Dim i As Long
  Isprime_number = True
  For i = 2 To Int(Sqr(n))
    If n Mod i = 0 Then Isprime_number = False: Exit Function
  Next
End Function
 
Upvote 0
Cái dzà... mấy cái này có từ đời nào rồi ---> Code của bạn đúng là cho tốc độ rất chậm đấy
Ít ra cũng phải vầy:
PHP:
Function Isprime_number(n As Long) As Boolean
  Dim i As Long
  Isprime_number = True
  For i = 2 To Int(Sqr(n))
    If n Mod i = 0 Then Isprime_number = False: Exit Function
  Next
End Function

em biết là code em chạy chậm nhất mà, hihi
Anh biết không, không ai mới bắt đầu giải một bài toán mà tối ưu cả đâu
ít nhất là phải dễ hiểu và làm sao cho mọi người thấy dễ hiểu, dễ gần gũi và làm được, rồi sau đó tự họ tìm tồi ra những cách hay hơn thôi(đó mới là quan trọng)

Lúc trước mới vào nghề giáo viên em cũng dạy code toàn là tối ưu không, nhưng mà sau khi học khóa phương pháp giảng dạy và lập trình cơ bản do thầy" NGUYỄN TẤN TRẦN MINH KHANG" trường tự nhiên dạy, thì em mới nhận thức ra là mọi thứ càng đơn giản, càng dễ hiểu càng hay. Chính vì vậy những bài em soạn cực kỳ đơn giản và kiến thức cũng rất nhẹ nhàng (cho những người mới bắt đầu)
 
Upvote 0
Theo như định nghĩa toán học, một số nguyên dương mà có đúng 2 ước là số nguyên tô

Dùng thuật toán đếm ước số là đơn giản và dễ hiểu thật vì nó chứng minh thuận.
Nhưng nếu dùng thuật toán này cũng đơn giản không kém:
Nếu 1 số chia hết cho 1 số khác 1 và chính số đó, thì đó không phải là số nguyên tố. (Chứng minh phản chứng)

Chính từ 2 cách lập luận khác nhau, dẫn đến 2 thuật toán khác nhau, nhưng rõ ràng là chứng minh phản chứng nhanh gấp bội.
 
Upvote 0
em biết là code em chạy chậm nhất mà, hihi
Anh biết không, không ai mới bắt đầu giải một bài toán mà tối ưu cả đâu
ít nhất là phải dễ hiểu và làm sao cho mọi người thấy dễ hiểu, dễ gần gũi và làm được, rồi sau đó tự họ tìm tồi ra những cách hay hơn thôi(đó mới là quan trọng)

Lúc trước mới vào nghề giáo viên em cũng dạy code toàn là tối ưu không, nhưng mà sau khi học khóa phương pháp giảng dạy và lập trình cơ bản do thầy" NGUYỄN TẤN TRẦN MINH KHANG" trường tự nhiên dạy, thì em mới nhận thức ra là mọi thứ càng đơn giản, càng dễ hiểu càng hay. Chính vì vậy những bài em soạn cực kỳ đơn giản và kiến thức cũng rất nhẹ nhàng (cho những người mới bắt đầu)
Topic này là Tập hợp các Hàm tự tạo để làm thư viện. Thiết nghĩ những bài post vào topic này nên là những thuật toán tối ưu hoặc ít nhất là hiện tại chưa có thuật toán nào hay hơn. Có như thế thì mới mong thực hiện được mục tiêu của topic này là tập hợp hàm tự tạo để lập một thư viện.
Nếu cái gì cũng post vào đây thì không khéo sau một thời gian ta lại phải tập hợp những Hàm tự tạo hay từ những cái đã "tập hợp" ở đây.

Vài dòng chia sẻ theo quan điểm cá nhân. Nếu có gì không phải xin các anh chị và các bạn bỏ qua.
 
Upvote 0
Topic này là Tập hợp các Hàm tự tạo để làm thư viện. Thiết nghĩ những bài post vào topic này nên là những thuật toán tối ưu hoặc ít nhất là hiện tại chưa có thuật toán nào hay hơn. Có như thế thì mới mong thực hiện được mục tiêu của topic này là tập hợp hàm tự tạo để lập một thư viện.
Nếu cái gì cũng post vào đây thì không khéo sau một thời gian ta lại phải tập hợp những Hàm tự tạo hay từ những cái đã "tập hợp" ở đây.

Vài dòng chia sẻ theo quan điểm cá nhân. Nếu có gì không phải xin các anh chị và các bạn bỏ qua.

Ý của huuthang_bd rất là hay, nhưng tôi lại nghĩ, mỗi người có hàm gì thì cứ post vào đây, mục đích là để phản biện, để phân tích, để đánh giá chất lượng; sau đó chúng ta tạo một topic khác tổng hợp lại những hàm có chất lượng cao. Vậy có được không ạ?
 
Upvote 0
như vậy thì mình gởi lại Hàm kiểm tra số nguyên tố chạy nhanh hơn một tí
Function Isprime_number(n As Long) As Boolean
Dim i As Long
Dim tam As Boolean
i = 2
tam = True
Do While (i <= Sqr(n))
If (n Mod i = 0) Then
Isprime_number = False
Exit Function
End If
i = i + 1
Loop
Isprime_number = tam
End Function
 
Upvote 0
Hàm nội suy 1 chiều cho cả ngang và dọc (Ptm0412):

PHP:
Option Base 1
Function Noisuy(XNum As Double, XRng As Range, YRng As Range) As Double
  If XNum = 0 Then Noisuy = 0: Exit Function
  Dim KnownX, KnownY, i, k
  k = 1
  ReDim KnownX(1 To XRng.Count)
  ReDim KnownY(1 To XRng.Count)
  For Each Cll In XRng
    KnownX(k) = Cll.Value
    k = k + 1
  Next
  k = 1
  For Each Cll In YRng
    KnownY(k) = Cll.Value
    k = k + 1
  Next
  For i = 1 To XRng.Count
    If KnownX(i) <= XNum And KnownX(i + 1) >= XNum Then
      Noisuy = KnownY(i) + ((XNum - KnownX(i)) * _
      (KnownY(i + 1) - KnownY(i))) / (KnownX(i + 1) - KnownX(i))
      Exit Function
    End If
  Next
End Function

Nguồn: http://www.giaiphapexcel.com/forum/...g-thức-tính-hệ-số-nội-suy&p=324510#post324510
 
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
Hàm tính bảng chấm công (Sa_DQ):

PHP:
Option Explicit
Function THCong(Cong As Range, LCg As String) As Variant
  Dim Cls As Range: Const DC As String = "/"
  For Each Cls In Cong
    Select Case UCase(LCg)
      Case "X"
        If Weekday(Cells(7, Cls.Column).Value) > 1 Then
          If UCase(Left(Cls.Value, 1)) = "X" Then
            THCong = THCong + 1
          ElseIf Cls.Value = "1/2" Then
            THCong = THCong + 0.5
          End If
        End If
      Case "P", "KP", "O", "L"
13      If UCase(Cls.Value) = "P" And LCg = "P" Then THCong = THCong + 1
        If UCase(Cls.Value) = "KP" And LCg = "KP" Then THCong = THCong + 1
15      If UCase(Cls.Value) = "O" And LCg = "O" Then THCong = THCong + 1
        If UCase(Cls.Value) = "L" And LCg = "L" Then THCong = THCong + 1
      Case "TG"
        If Weekday(Cells(7, Cls.Column).Value) = 1 Then
          If UCase(Cls.Value) = "X" Then
            THCong = THCong + 1
          ElseIf Cls.Value = "1/2" Then
            THCong = THCong + 0.5
          End If
        End If
      Case "TC"
        On Error Resume Next
        If Len(Cls.Value) >= 2 And InStr(Cls.Value, DC) < 1 Then
          THCong = THCong + CDbl(Right(Cls.Value, 1))
        End If
    End Select
  Next Cls
End Function

Nguồn: http://www.giaiphapexcel.com/forum/...-các-loại-công-dị-thường.&p=324663#post324663
 
Upvote 0
Hàm này dài dòng, và không tổng quát ở dòng
If XNum = 0 Then Noisuy = 0: Exit Function
sẽ sai, vì có trường hợp cần nội suy x=0?
Tôi không định đưa hàm này vào danh sách hàm đưa vào thư viện vì viết cho trường hợp cụ thể là file của anhTrung Chinh. Nhưng đã có nhận xét nên tôi sẽ giải thích như sau:
- File của anh Trung Chinh cần nội suy ra hệ số cho 1 giá trị vốn đầu tư. Vốn đầu tư = 0 thì cần tính hệ số làm gì, nên tôi cho hệ số = 0, anh Trung Chinh không phản hồi gì nên tôi không sửa. Hoặc anh ấy tự sửa được. Nếu dùng cho tổng quát, chỉ cần xoá dòng đó đi là xong.
- Thông thường bảng số liệu để tra nằm dọc theo cột, nhưng anh Trung Chinh để nằm theo dòng, nên tôi viết cho cả 2 trường hợp. Nếu chỉ viết cho 1 trường hợp dữ liệu nằm ngang, code chỉ cần ngắn như bài này: http://www.giaiphapexcel.com/forum/...g-thức-tính-hệ-số-nội-suy&p=324479#post324479
- Code này dài, dài vì phải gán giá trị vào mảng, đoạn code chính chỉ có 1 dòng lệnh bên trong vòng lặp For - Next.
- Cuối cùng, tuy code dài nhưng vì dùng mảng nên chắc chắn 1 điều là nó sẽ chạy rất nhanh.

Nếu Learning muốn sưu tầm, thì nên ghi rõ là nội suy 1 chiều cho cả dữ liệu ngang và dọc.
 
Lần chỉnh sửa cuối:
Upvote 0
Hàm này dài dòng, và không tổng quát ở dòng

sẽ sai, vì có trường hợp cần nội suy x=0
?
Câu lệnh:
Mã:
If [COLOR=#0000bb]XNum [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]0 Then Noisuy [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]0[/COLOR][COLOR=#007700]: Exit Function [/COLOR]
này hoàn toàn đúng trong phạm vi yêu cầu của đề bài.
Nó đã thoả mãn điều kiện khi dự án <= 5 tỷ thì chi phí này sẽ là 0.64%
Thế 0.64% * 0 = ? ; cần gì xét nữa.
Mình nghĩ rằng code (cùng một người viết) càng dài thì càng tổng quát vì người viết đã xét nhiều trường hợp, và chương trình chạy càng nhanh.
 
Lần chỉnh sửa cuối:
Upvote 0
Cái dzà... mấy cái này có từ đời nào rồi ---> Code của bạn đúng là cho tốc độ rất chậm đấy
Ít ra cũng phải vầy:
PHP:
Function Isprime_number(n As Long) As Boolean
  Dim i As Long
  Isprime_number = True
  For i = 2 To Int(Sqr(n))
    If n Mod i = 0 Then Isprime_number = False: Exit Function
  Next
End Function

Em mới viết ra hàm kiểm tra số nguyên tố anh ndu xem thử nó có tối ưu hơn hay không nha, hi hi

PHP:
Function ISPRIME_NUMBER(n As Long, Optional i As Long = 2) As Boolean
      If (n < 2) Then
                           ISPRIME_NUMBER = False
                   Exit Function
      ElseIf ((n < 4) Or (i > Sqr(n))) Then
                           ISPRIME_NUMBER = True
                   Exit Function
      ElseIf (n Mod i = 0) Then
                          ISPRIME_NUMBER = False
                  Exit Function
      Else
                      ISPRIME_NUMBER = ISPRIME_NUMBER(n, i + 1)
   End If
End Function
ví dụ
ISPRIME_NUMBER(9) = FALSE
ISPRIME_NUMBER(5)=TRUE
 
Lần chỉnh sửa cuối:
Upvote 0
Câu lệnh:
Mã:
If [COLOR=#0000bb]XNum [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]0 Then Noisuy [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]0[/COLOR][COLOR=#007700]: Exit Function [/COLOR]
này hoàn toàn đúng trong phạm vi yêu cầu của đề bài.
Nó đã thoả mãn điều kiện khi dự án <= 5 tỷ thì chi phí này sẽ là 0.64%
Thế 0.64% * 0 = ? ; cần gì xét nữa.
Mình nghĩ rằng code (cùng một người viết) càng dài thì càng tổng quát vì người viết đã xét nhiều trường hợp, và chương trình chạy càng nhanh.

Oh, quan trọng ở đây đưa vào hàm tổng quart và tiêu đề là hàm nội suy, vậy là sai bạn ah,
Càng dài càng tổng quát - lại sai nữa,
Nếu đúng như a ptm0412 nói tức là chỉ đúng với trường hợp cụ thế bài toán đó thôi
 
Upvote 0
Em mới viết ra hàm kiểm tra số nguyên tố anh ndu xem thử nó có tối ưu hơn hay không nha, hi hi

Không tối ưu bạn ah,
Đây là hình thức đệ quy cũng ra soát theo đệ quy từng số từ 1 - sqr(n) luôn (khi số đó là nguyên tố chẳng hạn)
Hơn nữa, mà thực tế người ta nói rằng nên Dùng vòng lặp để Trốn đệ quy - cái này bạn là GV TH chắc hiểu rõ hơn,

Ngoài ra thuật toán rà tìm này hảy còn chưa tối ưu,
 
Upvote 0
Oh, quan trọng ở đây đưa vào hàm tổng quart và tiêu đề là hàm nội suy, vậy là sai bạn ah,
Càng dài càng tổng quát - lại sai nữa,
Nếu đúng như a ptm0412 nói tức là chỉ đúng với trường hợp cụ thế bài toán đó thôi
Ở trên tôi có nói: nếu cần tổng quát thì xóa bỏ dòng lệnh If XNum = 0 Then Noisuy = 0: Exit Function
Và tôi cũng có nói: Hàm này có thể tính cho 2 vùng dữ liệu cả ngang và dọc, ở vị trí bất kỳ, theo ý bạn cũng vẫn chưa gọi là tổng quát, vậy thế nào có thể gọi là tổng quát?
Tiêu đề "hàm nội suy" là sai, vậy "hàm nội suy" thật sự đúng nó như thế nào? Bạn có thể cho biết không?

Nhân tiện, xin nhờ bạn và các cao thủ góp ý và viết cho 1 hàm "nội suy" thật sự đúng và thật sự tổng quát.
Xin cám ơn.
 
Upvote 0
Oh, quan trọng ở đây đưa vào hàm tổng quart và tiêu đề là hàm nội suy, vậy là sai bạn ah,
Càng dài càng tổng quát - lại sai nữa,
Nếu đúng như a ptm0412 nói tức là chỉ đúng với trường hợp cụ thế bài toán đó thôi
Bạn hãy giải bài toán theo ý của bạn để mọi người học hỏi, còn không thì phải chấp nhận người có giải pháp hay nhất trong trường hợp này. Nếu bạn chỉ nói suông thì chẳng ma nào tin.
Muốn tổng quát và chính xác thì quan hệ giữa các đại lượng (ở đây là tổng mức đầu tư và một chi phí nào đó) phải là một hàm số (y = f(x)).
Còn ở đây quan hệ kiểu bảng tra (toán đồ) mà đòi tổng quát là không thể, đòi hỏi sự chính xác càng không luôn vì khi ta nội (ngoại) suy là chấp nhận mối quan hệ tuyến tính trong từng đoạn mà thực tế cái tổng thể thì không phải vậy (không phải hàm bậc nhất, còn hàm gì thì không biết).
 
Lần chỉnh sửa cuối:
Upvote 0
Hàm kiểm tra khối ô có chứa Merge Cells hay không (minhthien321):

PHP:
Function MergeCheck(Rng As Range) As Boolean
  On Error GoTo MerCls
  MergeCheck = Rng.MergeCells: Exit Function
MerCls:
  MergeCheck = True
End Function


Thủ tục dưới đây làm cho khối ô Merge hoặc UnMerge:

PHP:
Sub MergeAndUnMerge()
  With Selection
    If MergeCheck(Selection) = True Then
      .UnMerge: .HorizontalAlignment = xlGeneral
    Else
      .Merge: .HorizontalAlignment = xlCenter
    End If
  End With
End Sub

Nói thêm là, tại sao ta làm cái thủ tục này, bởi vì có những lúc ta ProtectSheet mà đã bảo vệ thì Excel lại không cho Merge Cells, vì vậy nếu muốn sử dụng thủ tục này, đầu thủ tục ta cho UnProtect trước, cuối thủ tục ta lại Protect nó lại.
 
Lần chỉnh sửa cuối:
Upvote 0
Hàm lấy tên cột từ chỉ số cột trong Excel
Mã:
Function CotABC(ColIndex As Long) As String ' ham lay ten tu chi so cot
    CotABC = Replace(Cells(1, ColIndex).Address(0, 0), 1, "")
End Function
 
Upvote 0
Hàm lấy tên cột từ chỉ số cột trong Excel
Mã:
Function CotABC(ColIndex As Long) As String ' ham lay ten tu chi so cot
    CotABC = Replace(Cells(1, ColIndex).Address(0, 0), 1, "")
End Function
Đúng ra hàm này nên có 1 cái Optional, để khi ta chẳng gõ đối số ColIndex thì nó sẽ ngầm hiểu mặc định đang nói đến cột hiện hành (vì chắc gì đã nhớ biết được ta đang ở cột nào)
 
Upvote 0
Đúng ra hàm này nên có 1 cái Optional, để khi ta chẳng gõ đối số ColIndex thì nó sẽ ngầm hiểu mặc định đang nói đến cột hiện hành (vì chắc gì đã nhớ biết được ta đang ở cột nào)

Nhớ có lần thầy NDU có hướng dẫn về vụ này như sau:
PHP:
Function ColLetter(ByVal Cel As Range) As String
  ColLetter = Replace(Cells(1, Cel.Column).Address(0, 0), 1, "")
End Function

Không biết có phải ý thầy là vậy?
 
Upvote 0
Đúng ra hàm này nên có 1 cái Optional, để khi ta chẳng gõ đối số ColIndex thì nó sẽ ngầm hiểu mặc định đang nói đến cột hiện hành (vì chắc gì đã nhớ biết được ta đang ở cột nào)
Bạn ndu nói gì mình không hiểu, mình nghỉ chỉ cần thêm điều kiện về chỉ số cột cho các phiên bản Excel thôi.
Ví dụ mình áp dụng:

Dim iCol As Long
iCol = 50 ' thực tế tìm được từ code
MsgBox CotABC(iCol) '---> AX
 
Upvote 0
Bạn ndu nói gì mình không hiểu, mình nghỉ chỉ cần thêm điều kiện về chỉ số cột cho các phiên bản Excel thôi.
Ví dụ mình áp dụng:

Dim iCol As Long
iCol = 50 ' thực tế tìm được từ code
MsgBox CotABC(iCol) '---> AX
Tức là thế này:
- Với hàm của anh, nếu em gõ vào bảng tính công thức =CotABC(100) thì nó sẽ cho kết quả = CV, đúng không?
- Giả định em muốn biết cột hiện hành là tên gì thì làm sao? Em đang đứng ở cột CV, làm sao em biết cột này có số thứ tự =100 để mà điền vào hàm đây?
- Vậy sẽ cải tiến lại hàm sao cho nếu em gõ =CotABC() không có đối số thì ngầm định là đang nói đến cột tại ActiveCell
---------------
Em nghĩ sửa thành vầy sẽ ổn hơn:
PHP:
Function CotABC(Optional ColIndex) As String
  If IsMissing(ColIndex) Then ColIndex = Application.ThisCell.Column
  CotABC = Replace(Cells(1, ColIndex).Address(0, 0), 1, "")
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Tức là thế này:
- Với hàm của anh, nếu em gõ vào bảng tính công thức =CotABC(100) thì nó sẽ cho kết quả = CV, đúng không?
- Giả định em muốn biết cột hiện hành là tên gì thì làm sao? Em đang đứng ở cột CV, làm sao em biết cột này có số thứ tự =100 để mà điền vào hàm đây?
- Vậy sẽ cải tiến lại hàm sao cho nếu em gõ =CotABC() không có đối số thì ngầm định là đang nói đến cột tại ActiveCell
---------------
Em nghĩ sửa thành vầy sẽ ổn hơn:
PHP:
Function CotABC(Optional ColIndex) As String
  If IsMissing(ColIndex) Then ColIndex = Application.ThisCell.Column
  CotABC = Replace(Cells(1, ColIndex).Address(0, 0), 1, "")
End Function

Bị lỗi ndu à, nhưng sửa câu:
If IsMissing(ColIndex) Then ColIndex = Application.ThisCell.Column
thành:
If IsMissing(ColIndex) Then ColIndex = ActiveCell.Column
thì hết lỗi!
 
Upvote 0
Bị lỗi ndu à, nhưng sửa câu:
If IsMissing(ColIndex) Then ColIndex = Application.ThisCell.Column
thành:
If IsMissing(ColIndex) Then ColIndex = ActiveCell.Column
thì hết lỗi!
Lỗi gì ta? Các bạn khác kiểm tra giúp
ActiveCell khác ThisCell nha anh
Anh có thể thí nghiệm bằng cách thêm Application.Volatile vào đầu code như thế này:
PHP:
Function CotABC(Optional ColIndex) As String
  Application.Volatile
  If IsMissing(ColIndex) Then ColIndex = ActiveCell.Column
  CotABC = Replace(Cells(1, ColIndex).Address(0, 0), 1, "")
End Function
Xong, tại cell F1, anh gõ =CotABC() ---> Đương nhiên kết quả sẽ = chữ F
Thế nhưng khi anh di chuyển chuột sang 1 cell khác rồi bấm F9, nhìn lại kết quả ở F1, anh thấy gì nè?
Ẹc... Ẹc...
 

File đính kèm

Upvote 0
Lỗi gì ta? Các bạn khác kiểm tra giúp
ActiveCell khác ThisCell nha anh
Anh có thể thí nghiệm bằng cách thêm Application.Volatile vào đầu code như thế này:
PHP:
Function CotABC(Optional ColIndex) As String
  Application.Volatile
  If IsMissing(ColIndex) Then ColIndex = ActiveCell.Column
  CotABC = Replace(Cells(1, ColIndex).Address(0, 0), 1, "")
End Function
Xong, tại cell F1, anh gõ =CotABC() ---> Đương nhiên kết quả sẽ = chữ F
Thế nhưng khi anh di chuyển chuột sang 1 cell khác rồi bấm F9, nhìn lại kết quả ở F1, anh thấy gì nè?
Ẹc... Ẹc...
Ui chết rồi, mình cứ nghĩ là viết hàm để chạy trong VBA!!!

Vay ndu sử dụng hàm của ndu trong VBA thử xem
 
Lần chỉnh sửa cuối:
Upvote 0
Các Thầy có thể ráp 2 cái này thành 1 được không ạ?

Hàm 1:
PHP:
Function ColLetter(ByVal Cel As Range) As String
  ColLetter = Replace(Cells(1, Cel.Column).Address(0, 0), 1, "")
End Function
Hàm 2:
PHP:
Function CotABC(Optional ColIndex) As String
  If IsMissing(ColIndex) Then ColIndex = Application.ThisCell.Column
  CotABC = Replace(Cells(1, ColIndex).Address(0, 0), 1, "")
End Function

Với Hàm 1, lấy địa chỉ ô của bất kỳ cột nào sẽ ra tên cột đó, tuy nhiên với cấu trúc như vầy thì lỗi: =ColLetter()

Với Hàm 2, thêm tham số thì ra số cột, kể cả =CotABC() cũng ra kết quả cột hiện hành, tuy nhiên với cấu trúc này thì lỗi: =CotABC(A1)

Nếu các Thầy ráp lại được, có thể sẽ là một hàm tổng quát hơn!
 
Upvote 0
Hàm tách chữ

Em xin đóng góp hàm cùi bắp này:
PHP:
Function SplitWord(Str As String, C As String, VT As Long, Optional Words As Long = 1, Optional Op As Boolean = False) As String
Dim Arr As Variant, i As Long
If Op Then Str = StrReverse(Str): C = StrReverse(C)
Arr = Split(Str, C)
For i = VT To Application.WorksheetFunction.Min(VT + Words - 1, UBound(Arr) + 1)
    SplitWord = SplitWord & C & Arr(i - 1)
Next
SplitWord = Replace(SplitWord, C, "", 1, 1)
If Op Then SplitWord = StrReverse(SplitWord)
End Function
Dùng để tách chữ với nhiều tùy chọn.
Cú pháp:
Mã:
=SplitWord(Chuỗi_cần_tách, Chuỗi_phân_cách, Vị_trí_bắt_đầu, [Số_từ_cần_lấy], [Xuôi_hay_ngược])
 

File đính kèm

Upvote 0
Các Thầy có thể ráp 2 cái này thành 1 được không ạ?

Hàm 1:
PHP:
Function ColLetter(ByVal Cel As Range) As String
  ColLetter = Replace(Cells(1, Cel.Column).Address(0, 0), 1, "")
End Function
Hàm 2:
PHP:
Function CotABC(Optional ColIndex) As String
  If IsMissing(ColIndex) Then ColIndex = Application.ThisCell.Column
  CotABC = Replace(Cells(1, ColIndex).Address(0, 0), 1, "")
End Function

Với Hàm 1, lấy địa chỉ ô của bất kỳ cột nào sẽ ra tên cột đó, tuy nhiên với cấu trúc như vầy thì lỗi: =ColLetter()

Với Hàm 2, thêm tham số thì ra số cột, kể cả =CotABC() cũng ra kết quả cột hiện hành, tuy nhiên với cấu trúc này thì lỗi: =CotABC(A1)

Nếu các Thầy ráp lại được, có thể sẽ là một hàm tổng quát hơn!
Em nghĩ không nên ráp lại.
Giả sử sau khi ráp lại ta có hàm CotABC() có chức năng là chức năng của hai hàm trên. Khi đó nếu A1 có giá trị là 2, ta dùng công thức sau thì kết quả sẽ là A hay là B?
Mã:
CotABC(A1)
 
Upvote 0
Các Thầy có thể ráp 2 cái này thành 1 được không ạ?

Hàm 1:
PHP:
Function ColLetter(ByVal Cel As Range) As String
  ColLetter = Replace(Cells(1, Cel.Column).Address(0, 0), 1, "")
End Function
Hàm 2:
PHP:
Function CotABC(Optional ColIndex) As String
  If IsMissing(ColIndex) Then ColIndex = Application.ThisCell.Column
  CotABC = Replace(Cells(1, ColIndex).Address(0, 0), 1, "")
End Function

Với Hàm 1, lấy địa chỉ ô của bất kỳ cột nào sẽ ra tên cột đó, tuy nhiên với cấu trúc như vầy thì lỗi: =ColLetter()

Với Hàm 2, thêm tham số thì ra số cột, kể cả =CotABC() cũng ra kết quả cột hiện hành, tuy nhiên với cấu trúc này thì lỗi: =CotABC(A1)

Nếu các Thầy ráp lại được, có thể sẽ là một hàm tổng quát hơn!
Thí nghiệm vầy xem
PHP:
Function CotABC(Optional Col) As String
  Dim Tmp As Long
  On Error Resume Next
  If IsMissing(Col) Then
    Tmp = Application.ThisCell.Column
  ElseIf TypeName(Col) = "Range" Then
    Tmp = Col.Column
  Else
    Tmp = Col
  End If
  CotABC = Replace(Cells(1, Tmp).Address(0, 0), 1, "")
End Function
Em nghĩ không nên ráp lại.
Giả sử sau khi ráp lại ta có hàm CotABC() có chức năng là chức năng của hai hàm trên. Khi đó nếu A1 có giá trị là 2, ta dùng công thức sau thì kết quả sẽ là A hay là B?
Mã:
CotABC(A1)
Trường hợp này nếu ta viết CotABC(A1) thì nó sẽ hiểu A1 là Range (không lấy giá trị tại A1). Còn nếu viết vầy CotABC(Value(A1)) thì nó sẽ thế giá trị 2 của A1 vào công thức
 
Lần chỉnh sửa cuối:
Upvote 0
Thí nghiệm vầy xem
PHP:
Function CotABC(Optional Col) As String
  Dim Tmp As Long
  On Error Resume Next
  If IsMissing(Col) Then
    Tmp = Application.ThisCell.Column
  ElseIf TypeName(Col) = "Range" Then
    Tmp = Col.Column
  Else
    Tmp = Col
  End If
  CotABC = Replace(Cells(1, Tmp).Address(0, 0), 1, "")
End Function

Trường hợp này nếu ta viết CotABC(A1) thì nó sẽ hiểu A1 là Range (không lấy giá trị tại A1). Còn nếu viết vầy CotABC(Value(A1)) thì nó sẽ thế giá trị 2 của A1 vào công thức

Vâng, em đã kiểm tra, hàm cho ra kết quả rất chính xác! Cả 4 trường hợp ( [=CotABC()] ; [=CotABC(A1)] ; [=CotABC(1)] ; [=CotABC(VALUE(A1))] )

Nhưng với giá trị vượt quá 256 cột (đối với X2003) thì tính sao nhỉ? Với hàm này cho ra kết quả trắng, ừ thì vậy thôi chứ sao?
 
Upvote 0
Vâng, em đã kiểm tra, hàm cho ra kết quả rất chính xác! Cả 4 trường hợp ( [=CotABC()] ; [=CotABC(A1)] ; [=CotABC(1)] ; [=CotABC(VALUE(A1))] )

Nhưng với giá trị vượt quá 256 cột (đối với X2003) thì tính sao nhỉ? Với hàm này cho ra kết quả trắng, ừ thì vậy thôi chứ sao?
Hàm này sẽ tạo ra một chuỗi theo nguyên tắc đặt tên cột của Excel nhưng không bị giới hạn. Nếu thích anh có thể đưa vào hàm của anh ndu để cải tiến theo mục tiêu của anh.
PHP:
Function TenCot(Col As Long) As String
Do While Col > 0
    TenCot = Chr(((Col - 1) Mod 26) + 65) & TenCot
    Col = Int((Col - 1) / 26)
Loop
End Function
 
Upvote 0
Chuyển chuỗi Unicode sang ngôn ngữ VBA

Đôi khi chúng ta cần một câu thông báo bằng tiếng Việt trong khi đang lập trình một thủ tục nào đó. Hàm này sẽ chuyển chuỗi tiếng Việt Unicode sang ngôn ngữ VBA. Khỏi phải ngồi dò và ráp từng ký tự:
PHP:
Function CodeStr(MyStr As String) As String
Dim Str As String, CStart As Integer, CCount As Integer, Status As Boolean
Str = "-7842-7843-7841-259-7855-7857-7859-7861-7863-7845-7847-7849-7851-7853-273-7867-7869-7865-7871-7873-7875-7877-7879-7881-297-7883-7887-7885-7889-7891-7893-7895-7897-417-7899-7901-7903-7905-7907-7911-361-7909-432-7913-7915-7917-7919-7921-7923-7927-7929-7925-7840-258-7854-7856-7858-7860-7862-7844-7846-7848-7850-7852-272-7866-7868-7864-7870-7872-7874-7876-7878-7880-296-7882-7886-7884-7888-7890-7892-7894-7896-416-7898-7900-7902-7904-7906-7910-360-7908-431-7912-7914-7916-7918-7920-7922-7926-7928-7924-10-"
For i = 1 To Len(MyStr)
If InStr(Str, "-" & AscW(Mid(MyStr, i, 1)) & "-") = 0 Then
    If Not Status Then
        CStart = i:        Status = True
    End If
    CCount = CCount + 1
Else
    If Status Then CodeStr = CodeStr & IIf(CodeStr = "", "", " & ") & """" & Mid(MyStr, CStart, CCount) & """"
    Status = False
    CCount = 0
    CodeStr = CodeStr & IIf(CodeStr = "", "", " & ") & "ChrW(" & AscW(Mid(MyStr, i, 1)) & ")"
End If
Next
If Status Then CodeStr = CodeStr & IIf(CodeStr = "", "", " & ") & """" & Mid(MyStr, CStart, CCount) & """"
End Function
Ví dụ bạn gõ công thức:
Mã:
=CodeStr("Giải Pháp Excel - Công cụ tuyệt vời của bạn")
Thì sẽ được kết quả:
Mã:
"Gi" & ChrW(7843) & "i Pháp Excel - Công c" & ChrW(7909) & " tuy" & ChrW(7879) & "t v" & ChrW(7901) & "i c" & ChrW(7911) & "a b" & ChrW(7841) & "n"
 
Upvote 0
Ví dụ bạn gõ công thức:
Mã:
=CodeStr("Giải Pháp Excel - Công cụ tuyệt vời của bạn")
Thì sẽ được kết quả:
Mã:
"Gi" & ChrW(7843) & "i Pháp Excel - Công c" & ChrW(7909) & " tuy" & ChrW(7879) & "t v" & ChrW(7901) & "i c" & ChrW(7911) & "a b" & ChrW(7841) & "n"
Mình hỏi tí: Cái này dùng để làm gì? Theo mình hiểu thì khi muốn đưa chuổi "Giải Pháp Excel - Công cụ tuyệt vời của bạn" vào VBA, đầu tiên bạn phải gõ chuổi này vào đâu đó (trên bảng tính chẳng hạn), lấy kết quả xong mới đưa được vào VBA, đúng không?
 
Upvote 0
Mình hỏi tí: Cái này dùng để làm gì? Theo mình hiểu thì khi muốn đưa chuổi "Giải Pháp Excel - Công cụ tuyệt vời của bạn" vào VBA, đầu tiên bạn phải gõ chuổi này vào đâu đó (trên bảng tính chẳng hạn), lấy kết quả xong mới đưa được vào VBA, đúng không?
Đúng rồi anh.
Ví dụ trong VBA anh muốn viết lệnh để nhập chuỗi "Giải Pháp Excel - Công cụ tuyệt vời của bạn" vào ô A1 thì nhập công thức này vào một ô trên Excel
Mã:
=CodeStr("Giải Pháp Excel - Công cụ tuyệt vời của bạn")
Nhập xong nhấn F9 rồi copy, dán vào code:
PHP:
[A1] = "Gi" & ChrW(7843) & "i Pháp Excel - Công c" & ChrW(7909) & " tuy" & ChrW(7879) & "t v" & ChrW(7901) & "i c" & ChrW(7911) & "a b" & ChrW(7841) & "n"
 
Upvote 0
Đúng rồi anh.
Ví dụ trong VBA anh muốn viết lệnh để nhập chuỗi "Giải Pháp Excel - Công cụ tuyệt vời của bạn" vào ô A1 thì nhập công thức này vào một ô trên Excel
Mã:
=CodeStr("Giải Pháp Excel - Công cụ tuyệt vời của bạn")
Nhập xong nhấn F9 rồi copy, dán vào code:
PHP:
[A1] = "Gi" & ChrW(7843) & "i Pháp Excel - Công c" & ChrW(7909) & " tuy" & ChrW(7879) & "t v" & ChrW(7901) & "i c" & ChrW(7911) & "a b" & ChrW(7841) & "n"
Vậy thì.. cực quá...
Tôi dùng hàm này:
PHP:
Function UniConvert(Text As String, InputMethod As String) As String
  Dim VNI_Type, Telex_Type, CharCode, Temp, i As Long
  UniConvert = Text
  VNI_Type = Array("a81", "a82", "a83", "a84", "a85", "a61", "a62", "a63", "a64", "a65", "e61", _
      "e62", "e63", "e64", "e65", "o61", "o62", "o63", "o64", "o65", "o71", "o72", "o73", "o74", _
      "o75", "u71", "u72", "u73", "u74", "u75", "a1", "a2", "a3", "a4", "a5", "a8", "a6", "d9", _
      "e1", "e2", "e3", "e4", "e5", "e6", "i1", "i2", "i3", "i4", "i5", "o1", "o2", "o3", "o4", _
      "o5", "o6", "o7", "u1", "u2", "u3", "u4", "u5", "u7", "y1", "y2", "y3", "y4", "y5")
  Telex_Type = Array("aws", "awf", "awr", "awx", "awj", "aas", "aaf", "aar", "aax", "aaj", "ees", _
      "eef", "eer", "eex", "eej", "oos", "oof", "oor", "oox", "ooj", "ows", "owf", "owr", "owx", _
      "owj", "uws", "uwf", "uwr", "uwx", "uwj", "as", "af", "ar", "ax", "aj", "aw", "aa", "dd", _
      "es", "ef", "er", "ex", "ej", "ee", "is", "if", "ir", "ix", "ij", "os", "of", "or", "ox", _
      "oj", "oo", "ow", "us", "uf", "ur", "ux", "uj", "uw", "ys", "yf", "yr", "yx", "yj")
  CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
      ChrW(7849), ChrW(7851), ChrW(7853), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
      ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), ChrW(7899), ChrW(7901), ChrW(7903), _
      ChrW(7905), ChrW(7907), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), ChrW(7921), ChrW(225), _
      ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), ChrW(259), ChrW(226), ChrW(273), ChrW(233), ChrW(232), _
      ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), ChrW(7881), ChrW(297), ChrW(7883), _
      ChrW(243), ChrW(242), ChrW(7887), ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(250), ChrW(249), _
      ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
  Select Case InputMethod
    Case Is = "VNI": Temp = VNI_Type
    Case Is = "Telex": Temp = Telex_Type
  End Select
  For i = 0 To UBound(CharCode)
    UniConvert = Replace(UniConvert, Temp(i), CharCode(i))
    UniConvert = Replace(UniConvert, UCase(Temp(i)), UCase(CharCode(i)))
  Next i
End Function
Gõ trực tiếp vào VBA luôn. Ví dụ:
PHP:
Sub TestVNI()
  Dim Text As String
  Text = "Gia3i pha1p Excel - Co6ng cu5 tuye65t vo72i cu3a ba5n"
  Application.ExecuteExcel4Macro ("ALERT(""" & UniConvert(Text, "VNI") & """,2)")
End Sub
Hoặc
PHP:
Sub TestTelex()
  Dim Text As String
  Text = "Giari phasp Excel - Coong cuj tuyeejt vowfi cura bajn"
  Application.ExecuteExcel4Macro ("ALERT(""" & UniConvert(Text, "Telex") & """,2)")
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Vậy thì.. cực quá...
Tôi dùng hàm này:
PHP:
Function UniConvert(Text As String, InputMethod As String) As String
  Dim VNI_Type, Telex_Type, CharCode, Temp, i As Long
  UniConvert = Text
  VNI_Type = Array("a81", "a82", "a83", "a84", "a85", "a61", "a62", "a63", "a64", "a65", "e61", _
      "e62", "e63", "e64", "e65", "o61", "o62", "o63", "o64", "o65", "o71", "o72", "o73", "o74", _
      "o75", "u71", "u72", "u73", "u74", "u75", "a1", "a2", "a3", "a4", "a5", "a8", "a6", "d9", _
      "e1", "e2", "e3", "e4", "e5", "e6", "i1", "i2", "i3", "i4", "i5", "o1", "o2", "o3", "o4", _
      "o5", "o6", "o7", "u1", "u2", "u3", "u4", "u5", "u7", "y1", "y2", "y3", "y4", "y5")
  Telex_Type = Array("aws", "awf", "awr", "awx", "awj", "aas", "aaf", "aar", "aax", "aaj", "ees", _
      "eef", "eer", "eex", "eej", "oos", "oof", "oor", "oox", "ooj", "ows", "owf", "owr", "owx", _
      "owj", "uws", "uwf", "uwr", "uwx", "uwj", "as", "af", "ar", "ax", "aj", "aw", "aa", "dd", _
      "es", "ef", "er", "ex", "ej", "ee", "is", "if", "ir", "ix", "ij", "os", "of", "or", "ox", _
      "oj", "oo", "ow", "us", "uf", "ur", "ux", "uj", "uw", "ys", "yf", "yr", "yx", "yj")
  CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
      ChrW(7849), ChrW(7851), ChrW(7853), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
      ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), ChrW(7899), ChrW(7901), ChrW(7903), _
      ChrW(7905), ChrW(7907), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), ChrW(7921), ChrW(225), _
      ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), ChrW(259), ChrW(226), ChrW(273), ChrW(233), ChrW(232), _
      ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), ChrW(7881), ChrW(297), ChrW(7883), _
      ChrW(243), ChrW(242), ChrW(7887), ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(250), ChrW(249), _
      ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
  Select Case InputMethod
    Case Is = "VNI": Temp = VNI_Type
    Case Is = "Telex": Temp = Telex_Type
  End Select
  For i = 0 To UBound(CharCode)
    UniConvert = Replace(UniConvert, Temp(i), CharCode(i))
    UniConvert = Replace(UniConvert, UCase(Temp(i)), UCase(CharCode(i)))
  Next i
End Function
Gõ trực tiếp vào VBA luôn. Ví dụ:
PHP:
Sub TestVNI()
  Dim Text As String
  Text = "Gia3i pha1p Excel - Co6ng cu5 tuye65t vo72i cu3a ba5n"
  Application.ExecuteExcel4Macro ("ALERT(""" & UniConvert(Text, "VNI") & """,2)")
End Sub
Hoặc
PHP:
Sub TestTelex()
  Dim Text As String
  Text = "Giari phasp Excel - Coong cuj tuyeejt vowfi cura bajn"
  Application.ExecuteExcel4Macro ("ALERT(""" & UniConvert(Text, "Telex") & """,2)")
End Sub
Em là người có thói quen bỏ dấu cuối từ khi gõ tiếng Việt nên chắc không dùng được hàm của anh. Ví dụ chữ "Giải" em sẽ gõ là Giair
Với lại nếu dùng hàm của anh dưới dạng Add-in thì khi gửi file cho người khác phải copy luôn hàm này vào trong file.
 
Lần chỉnh sửa cuối:
Upvote 0
Em là người có thói quen bỏ dấu cuối từ khi gõ tiếng Việt nên chắc không dùng được hàm của anh. Ví dụ chữ "Giải" em sẽ gõ là Giair
Tôi cũng đang có tham vọng sẽ viết hàm ở mức tổng quát hơn, tức cho phép gõ dấu tự do, nhưng tạm thời vẫn chưa nghĩ được giải thuật tối ưu ---> Hay là Thắng giúp 1 tay để hoàn thiện đi
Với lại nếu dùng hàm của anh dưới dạng Add-in thì khi gửi file cho người khác phải copy luôn hàm này vào trong file.
Thì hàm tự tạo nào cũng vậy mà, đâu riêng gì hàm của tôi. Vấn đề là nó giúp ta đở cực công với mấy cái ChrW(...) gì gì đó là khỏe rồi
 
Upvote 0
Tôi cũng đang có tham vọng sẽ viết hàm ở mức tổng quát hơn, tức cho phép gõ dấu tự do, nhưng tạm thời vẫn chưa nghĩ được giải thuật tối ưu ---> Hay là Thắng giúp 1 tay để hoàn thiện đi
Em nghĩ tổng quát hoá hàm này là một việc rất khó. Nếu gõ dấu tự do thì có rất nhiều trường hợp nên không thể áp dụng thuật toán cũ. Ngoài ra, có thể gặp một số trường hợp kết quả chuyễn đổi ngoài mong muốn do chuỗi đầu vào có các nhóm ký tự vô tình trùng với các ký tự tiếng Việt. Ví dụ như:
PHP:
Sub TestTelex()
  Dim Text As String
  Text = "Text = "Chuwowng trifnh duwj ddoasn keest quar xoor soos treen excel""
  Application.ExecuteExcel4Macro ("ALERT(""" & UniConvert(Text, "Telex") & """,2)")
End Sub
Kết quả là: Chương trình dự đoán kết quả xổ số trên ẽcel (Chương trình dự đoán kết quả xổ số trên excel)
Hoặc
PHP:
Sub TestVNI()
  Dim Text As String
  Text = "Ba5n chu7a nha65p gia1 tri5 cho y1"
  Application.ExecuteExcel4Macro ("ALERT(""" & UniConvert(Text, "VNI") & """,2)")
End Sub
Kết quả là: Bạn chưa nhập giá trị cho ý (Bạn chưa nhập giá trị cho y1)
Thì hàm tự tạo nào cũng vậy mà, đâu riêng gì hàm của tôi. Vấn đề là nó giúp ta đở cực công với mấy cái ChrW(...) gì gì đó là khỏe rồi
Ý em là hàm này chỉ mang tính chất hỗ trợ, về nguyên tắc ta có thể bỏ nó ra khỏi chương trình nên em thấy nếu file nào cũng đưa nó vào là không cần thiết.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Khó viết hàm tổng quát cho trường hợp này lắm Thầy ndu và Hữu Thắng ơi, bởi gõ dấu tự do bị ràng buộc nhiều điều kiện. Mình thì gõ kiểu VNI và gõ dấu kiểu tự do. Ví dụ nhỏ là viết chữ VƯỜN thì gõ VUON72 có khi lại gõ VUON27 có bộ gõ lại bắt gõ 2 số 7 mới được ƯƠ có bộ gõ chỉ cần gõ 1 lần 7.
 
Upvote 0
Em nghĩ tổng quát hoá hàm này là một việc rất khó. Nếu gõ dấu tự do thì có rất nhiều trường hợp nên không thể áp dụng thuật toán cũ. Ngoài ra, có thể gặp một số trường hợp kết quả chuyễn đổi ngoài mong muốn do chuỗi đầu vào có các nhóm ký tự vô tình trùng với các ký tự tiếng Việt. Ví dụ như:
PHP:
Sub TestTelex()
  Dim Text As String
  Text = "Text = "Chuwowng trifnh duwj ddoasn keest quar xoor soos treen excel""
  Application.ExecuteExcel4Macro ("ALERT(""" & UniConvert(Text, "Telex") & """,2)")
End Sub
Kết quả là: Chương trình dự đoán kết quả xổ số trên ẽcel (Chương trình dự đoán kết quả xổ số trên excel)
Hoặc
PHP:
Sub TestVNI()
  Dim Text As String
  Text = "Ba5n chu7a nha65p gia1 tri5 cho y1"
  Application.ExecuteExcel4Macro ("ALERT(""" & UniConvert(Text, "VNI") & """,2)")
End Sub
Kết quả là: Bạn chưa nhập giá trị cho ý (Bạn chưa nhập giá trị cho y1)

Ý em là hàm này chỉ mang tính chất hỗ trợ, về nguyên tắc ta có thể bỏ nó ra khỏi chương trình nên em thấy nếu file nào cũng đưa nó vào là không cần thiết.
Tôi chỉ ngại suy nghĩ 1 thuật toán tổng quát thôi chứ còn áp dụng thì rất dễ
Ví dụ chuổi "Ba5n chu7a nha65p gia1 tri5 cho y1" tôi sẽ không làm như trên, cái nào không cần convert thì chẳng việc gì phải cho vào hàm Convert, đúng không?
(đã đưa vào hàm là ý muốn nó "dịch" cơ mà)
Ví dụ code trên tôi viết thế này:
PHP:
Sub TestVNI()
  Dim Text As String
  Text = "Ba5n chu7a nha65p gia1 tri5 cho"
  Application.ExecuteExcel4Macro ("ALERT(""" & UniConvert(Text, "VNI") & " y1"",2)")
End Sub
-----------------
Unikey đã làm được cái việc gõ dấu tự do đấy thôi! Tức 1 thuật toán tính toán cho việc gõ dấu tự do là hoàn toàn khả thi (chỉ tại mình suy nghĩ chưa ra thôi)
Ngoài ra, nếu tôi nhớ không lầm thì trên GPE đã từng có ai đó làm việc này rồi thì phải
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi chỉ ngại suy nghĩ 1 thuật toán tổng quát thôi chứ còn áp dụng thì rất dễ
Ví dụ chuổi "Ba5n chu7a nha65p gia1 tri5 cho y1" tôi sẽ không làm như trên, cái nào không cần convert thì chẳng việc gì phải cho vào hàm Convert, đúng không?
(đã đưa vào hàm là ý muốn nó "dịch" cơ mà)
Ví dụ code trên tôi viết thế này:
PHP:
Sub TestVNI()
  Dim Text As String
  Text = "Ba5n chu7a nha65p gia1 tri5 cho"
  Application.ExecuteExcel4Macro ("ALERT(""" & UniConvert(Text, "VNI") & " y1"",2)")
End Sub
-----------------
Unikey đã làm được cái việc gõ dấu tự do đấy thôi! Tức 1 thuật toán tính toán cho việc gõ dấu tự do là hoàn toàn khả thi (chỉ tại mình suy nghĩ chưa ra thôi)
Ngoài ra, nếu tôi nhớ không lầm thì trên GPE đã từng có ai đó làm việc này rồi thì phải
Em làm thử, mọi người kiểm tra lại giùm nhé.
PHP:
Function UniConvert(ByVal Text As String, ByVal InputMethod As String) As String
  Dim VNI_Type, Telex_Type, CharCode, Temp, i As Long
  UniConvert = SapXepChuoi(Text, InputMethod)
  VNI_Type = Array("a81", "a82", "a83", "a84", "a85", "a61", "a62", "a63", "a64", "a65", "e61", _
      "e62", "e63", "e64", "e65", "o61", "o62", "o63", "o64", "o65", "o71", "o72", "o73", "o74", _
      "o75", "u71", "u72", "u73", "u74", "u75", "a1", "a2", "a3", "a4", "a5", "a8", "a6", "d9", _
      "e1", "e2", "e3", "e4", "e5", "e6", "i1", "i2", "i3", "i4", "i5", "o1", "o2", "o3", "o4", _
      "o5", "o6", "o7", "u1", "u2", "u3", "u4", "u5", "u7", "y1", "y2", "y3", "y4", "y5")
  Telex_Type = Array("aws", "awf", "awr", "awx", "awj", "aas", "aaf", "aar", "aax", "aaj", "ees", _
      "eef", "eer", "eex", "eej", "oos", "oof", "oor", "oox", "ooj", "ows", "owf", "owr", "owx", _
      "owj", "uws", "uwf", "uwr", "uwx", "uwj", "as", "af", "ar", "ax", "aj", "aw", "aa", "dd", _
      "es", "ef", "er", "ex", "ej", "ee", "is", "if", "ir", "ix", "ij", "os", "of", "or", "ox", _
      "oj", "oo", "ow", "us", "uf", "ur", "ux", "uj", "uw", "ys", "yf", "yr", "yx", "yj")
  CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
      ChrW(7849), ChrW(7851), ChrW(7853), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
      ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), ChrW(7899), ChrW(7901), ChrW(7903), _
      ChrW(7905), ChrW(7907), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), ChrW(7921), ChrW(225), _
      ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), ChrW(259), ChrW(226), ChrW(273), ChrW(233), ChrW(232), _
      ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), ChrW(7881), ChrW(297), ChrW(7883), _
      ChrW(243), ChrW(242), ChrW(7887), ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(250), ChrW(249), _
      ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
  Select Case InputMethod
    Case Is = "VNI": Temp = VNI_Type
    Case Is = "Telex": Temp = Telex_Type
  End Select
  For i = 0 To UBound(CharCode)
    UniConvert = Replace(UniConvert, Temp(i), CharCode(i))
    UniConvert = Replace(UniConvert, UCase(Temp(i)), UCase(CharCode(i)))
  Next i
End Function
PHP:
Sub TestTelex()
  Dim Text As String
  Text = "Giair phaps Excel - Coong cuj tuyeetj vowif cuar banj"
  Application.ExecuteExcel4Macro ("ALERT(""" & UniConvert(Text, "Telex") & """,2)")
End Sub
PHP:
Sub TestVNI()
  Dim Text As String
  Text = "Giai3 phap1 Excel - Co6ng cu5 tuye6t5 vo7i2 cua3 ban5"
  Application.ExecuteExcel4Macro ("ALERT(""" & UniConvert(Text, "VNI") & """,2)")
End Sub
PHP:
Private Function ChuyenDoiTuTelex(ByVal Tu As String) As String
    Dim NguyenAmChinh As String, NguyenAm As String, ViTriNguyenAm As Long, Dau As String, i As Long
    For i = 1 To Len(Tu)
        If InStr("ueoaiy", Mid(Tu, i, 1)) Then
            If ViTriNguyenAm = 0 Then ViTriNguyenAm = i
            NguyenAm = NguyenAm & Mid(Tu, i, 1)
        End If
    Next
    If NguyenAm = "" Then
        ChuyenDoiTuTelex = Tu
        Exit Function
    End If
    For i = 1 To 5
        If InStr(Tu, Mid("sfrxj", i, 1)) > ViTriNguyenAm Then Dau = Mid("sfrxj", i, 1)
    Next
    If Len(NguyenAm) = 3 Then
        NguyenAmChinh = Mid(NguyenAm, 2, 1)
    ElseIf NguyenAm = "uo" Or NguyenAm = "ou" Then
        NguyenAmChinh = "o"
    ElseIf InStr(NguyenAm, "e") Then
        NguyenAmChinh = "e"
    Else
        NguyenAmChinh = Left(NguyenAm, 1)
    End If
    If Dau <> "" Then
        Tu = Replace(Tu, NguyenAmChinh, NguyenAmChinh & Dau)
        Tu = Left(Tu, InStr(Tu, NguyenAmChinh) + 1) & Replace(Tu, Dau, "", InStr(Tu, NguyenAmChinh) + 2)
    End If
    For i = 1 To 4
        If Len(Tu) - Len(Replace(Tu, Mid("daeo", i, 1), "")) = 2 Then
            Tu = Replace(Tu, Mid("daeo", i, 1), String(2, Mid("daeo", i, 1)))
            Tu = Left(Tu, InStr(Tu, Mid("daeo", i, 1)) + 1) & Replace(Tu, Mid("daeo", i, 1), "", InStr(Tu, Mid("daeo", i, 1)) + 2)
        End If
    Next
    If InStr(Tu, "w") Then
        Tu = Replace(Tu, "w", "")
        For i = 1 To 3
            Tu = Replace(Tu, Mid("aou", i, 1), Mid("aou", i, 1) & "w")
        Next
    End If
ChuyenDoiTuTelex = Tu
End Function
PHP:
Private Function ChuyenDoiTuVNI(ByVal Tu As String) As String
    Dim NguyenAmChinh As String, NguyenAm As String, ViTriNguyenAm As Long, Dau As String, i As Long
    For i = 1 To Len(Tu)
        If InStr("ueoaiy", Mid(Tu, i, 1)) Then
            If ViTriNguyenAm = 0 Then ViTriNguyenAm = i
            NguyenAm = NguyenAm & Mid(Tu, i, 1)
        End If
    Next
    If NguyenAm = "" Then
        ChuyenDoiTuVNI = Tu
        Exit Function
    End If
    For i = 1 To 5
        If InStr(Tu, CStr(i)) > ViTriNguyenAm Then Dau = CStr(i)
    Next
    If Len(NguyenAm) = 3 Then
        NguyenAmChinh = Mid(NguyenAm, 2, 1)
    ElseIf NguyenAm = "uo" Or NguyenAm = "ou" Then
        NguyenAmChinh = "o"
    ElseIf InStr(NguyenAm, "e") Then
        NguyenAmChinh = "e"
    Else
        NguyenAmChinh = Left(NguyenAm, 1)
    End If
    If Dau <> "" Then
        Tu = Replace(Tu, Dau, "")
        Tu = Replace(Tu, NguyenAmChinh, NguyenAmChinh & Dau)
    End If
    If InStr(Tu, "9") Then
        Tu = Replace(Tu, "9", "")
        Tu = Replace(Tu, "d", "d9")
    End If
    
    If InStr(Tu, "8") Then
        Tu = Replace(Tu, "8", "")
        Tu = Replace(Tu, "a", "a8")
    End If
    If InStr(Tu, "7") Then
        Tu = Replace(Tu, "7", "")
        Tu = Replace(Tu, "o", "o7")
        Tu = Replace(Tu, "u", "u7")
    End If
    If InStr(Tu, "6") Then
        Tu = Replace(Tu, "6", "")
        Tu = Replace(Tu, "a", "a6")
        Tu = Replace(Tu, "e", "e6")
        Tu = Replace(Tu, "o", "o6")
    End If
ChuyenDoiTuVNI = Tu
End Function
PHP:
Function SapXepChuoi(ByVal Chuoi As String, ByVal InputMethod As String) As String
Dim Arr As Variant, i As Long
Arr = Split(Chuoi, " ")
Select Case InputMethod
    Case "Telex"
        For i = 0 To UBound(Arr)
            Arr(i) = ChuyenDoiTuTelex(Arr(i))
        Next
    Case "VNI"
        For i = 0 To UBound(Arr)
            Arr(i) = ChuyenDoiTuVNI(Arr(i))
        Next
End Select
SapXepChuoi = Join(Arr, " ")
End Function
Thuật toán: Sắp xếp lại các ký tự cho đúng chuẩn trước khi đưa vào hàm của anh ndu
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hàm lấy dữ liệu (1 cột) không trùng (ndu96081631):

PHP:
Function UniqueList(Range As Range)
  Dim Clls As Range
  With CreateObject("Scripting.Dictionary")
    For Each Clls In Range
      If Not IsEmpty(Clls) And Not .Exists(Clls.Value) Then .Add Clls.Value, Clls.Value
    Next Clls
    UniqueList = .Keys
  End With
End Function

Cách sử dụng:

PHP:
Private Sub ComboBox1_DropButtonClick()
  With Range([A3], [A65536].End(xlUp))
    ComboBox1.List() = UniqueList(.Cells)
  End With
End Sub

Nguồn: http://www.giaiphapexcel.com/forum/...-combobox-validation-list&p=192283#post192283
 
Upvote 0
Hàm tạo dãy số ngẫu nhiên không trùng (anhtuan1066):

PHP:
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long)
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  On Error Resume Next
  If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
  With CreateObject("Scripting.Dictionary")
    Do
      .Add Int(Rnd() * (Top - Bottom + 1)) + Bottom, ""
    Loop Until .Count = Amount
    UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
  End With
End Function

Cách sử dụng:

PHP:
=UniqueRandomNum(Số nhỏ, Số lớn, bao nhiêu số cần tạo)

Nguồn: http://www.giaiphapexcel.com/forum/...số-ngẫu-nhiên-không-trùng&p=184501#post184501
 
Upvote 0
Hàm lấy dữ liệu (1 cột) không trùng (ndu96081631):

PHP:
Function UniqueList(Range As Range)
  Dim Clls As Range
  With CreateObject("Scripting.Dictionary")
    For Each Clls In Range
      If Not IsEmpty(Clls) And Not .Exists(Clls.Value) Then .Add Clls.Value, Clls.Value
    Next Clls
    UniqueList = .Keys
  End With
End Function

Cách sử dụng:

PHP:
Private Sub ComboBox1_DropButtonClick()
  With Range([A3], [A65536].End(xlUp))
    ComboBox1.List() = UniqueList(.Cells)
  End With
End Sub

Nguồn: http://www.giaiphapexcel.com/forum/showthread.php?28472-lọc-danh-sách-không-bị-trùng-tên-và-khoảng-trắng-cho-combobox-validation-list&p=192283#post192283
Cái hàm UniqueList này chưa hoàn thiện đâu!
Hàm ấy tôi viết đã lâu lắm rồi, sau này sửa lại thế này:
PHP:
Function UniqueList(ParamArray sArray())
  Dim Item, TmpArr, SubArr
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      TmpArr = SubArr
      If TypeName(TmpArr) <> "Variant()" Then
        If TmpArr <> "" Then .Add TmpArr, ""
      Else
        For Each Item In TmpArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
        Next
      End If
    Next
    UniqueList = .Keys
  End With
End Function
Hàm này hoạt động toàn bộ trên Array và cho phép tham chiếu đến nhiều vùng không liên tục
 
Lần chỉnh sửa cuối:
Upvote 0
Một số hàm mảng tự tạo (Phần I)

1./ Hàm trả về một mảng


Như chúng ta đã biết, các hàm trong excel nói chung, trong đó có cả các hàm tự tạo (UFD) thường trả về giá trị tại một ô hiện hành.

Vậy có thể có cách nào đó để một hàm tự tạo trả về là một mảng các giá trị (hiển thị trên các ô khác nhau của 1 vùng)

Lấy ví dụ: Ta dùng hàm VLOOKUP() để nó trả về phần tử đầu tiên thỏa mãn điều kiện của hàm. Tuy nhiên trong bảng tham chiếu có đến hơn vài phần tử thỏa mãn với điều kiện đó. Vậy có cách nào để nhập công thức vào một hay nhiều ô thì tất cả các kết quả thỏa điều kiện của hàm sẽ hiện ra ở các ô (kể từ ô hiện hành) hay không?

Muốn đạt mục đích này, ta xét đến hàm tự tạo sau đây dùng để giải phương trình bậc hai:
PHP:
Function PTBac2(aA As Double, bB As Double, cC As Double) 
 Dim Temp( 1 To 3): Dim DelTa As Double 

 DelTa= (bB ^ 2) - (4 * aA * cC) 
 Temp(1) = “Phuong Trinh “ 
 Select Case DelTa 
 Case Is < 0 
     Temp(1) = Temp(1) & "Vo nghiem" 
     Temp(2) = " ":             Temp(3) = " " 
 Case 0 
     Temp(1) = Temp(1) & "Mot nghiem:" 
     Temp(2) = -bB / ( 2 * aA): Temp(3) = "" 
 Case Else 
     Temp(1) = Temp(1) & "Hai nghiem:" 
     Temp(2) = (-bB + Sqr( DelTa)) / ( 2 * aA) 
     Temp(3) = (-bB - Sqr( DelTa))/(2 * aA) 
 End Select 
 PTBac2 = Temp 
End Function

Tại trang tính (“GPE”) trống nào đó, ta nhập các trị 1, 3 & -4 vô các ô tương ứng [A1], [B1] & [C1]
Sau đó dùng chuột quét chọn các ô từ [B3] đến [d3]
Tiếp theo bấm chuột lên thanh công thức và nhập cú pháp hàm
=PTBac2( A1, B1, C1)
Sau đó ta bấm tổ hợp phím giành cho hàm mảng ({CTRL}+{ATL}+{ENTER}) để nhận kết quả

Nhận xét: Các kết quả của hàm thể hiện trên cùng 1 dòng của trang tính;
Nếu giờ ta muốn thể hiện trên cùng 1 cột các kết quả này thì làm thế nào?

Lúc đó ta phải dùng đến 1 biến mảng hai chiều & hàm có nội dung được chỉnh sửa như dưới đây:
PHP:
Function PTBac2C(aA As Double, bB As Double, cC As Double) 
Dim Temp(1 To 3, 1 To 1): Dim DelTa As Double 
DelTa = (bB ^ 2) - (4 * aA * cC) 
Temp(1, 1) = "Phuong Trinh " 
Select Case DelTa 
Case Is < 0 
   Temp(1, 1) = Temp(1, 1) & "Vo nghiem" 
   Temp(2, 1) = " ":          Temp(3, 1) = " " 
Case 0 
   Temp(1, 1) = Temp(1, 1) & "Mot nghiem:" 
   Temp(2, 1) = -bB / (2 * aA): Temp(3, 1) = "" 
Case Else 
   Temp(1, 1) = Temp(1, 1) & "Hai nghiem:" 
   Temp(2, 1) = (-bB + Sqr(DelTa)) / (2 * aA) 
   Temp(3, 1) = (-bB - Sqr(DelTa)) / (2 * aA) 
End Select 
PTBac2C = Temp 
End Function

Lúc này cú pháp hàm tại các ô [B5]..[B7] sẽ fải là: =PTBac2C(A1,B1,C1- 4)

*​
* *​
*​

2./ Dùng hàm mảng tự tạo để thể hiện các nghiệm của fương trình đường tròn

Ta có bài toán: Hãy tìm các căp nghiệm của fương trình
X^2 + Y^2 = Z ^2
,với X & Y là số nguyên dương < 21

Để giải bài tập này, chúng ta nhờ tới sự hỗ trợ của hàm mảng tự tạo sau đây:

PHP:
Option Explicit:        Option Base 1 
Function DuongTron() 
 Dim Xx As Byte, Yy As Byte, Zz As Double, Dem As Byte 
 ReDim MDL(30, 3) 
 For Xx = 1 To 20 
   For Yy = 1 To 20 
      Zz = Abs((Xx ^ 2 + Yy ^ 2) ^ (1 / 2)) 
      If Int(Zz) = Zz Then 
         Dem = Dem + 1 
         MDL(Dem, 1) = Xx:       MDL(Dem, 2) = Yy 
         MDL(Dem, 3) = Zz 
      End If 
 Next Yy, Xx 
 For Xx = Dem + 1 To 30 
   MDL(Xx, 1) = "":              MDL(Xx, 2) = "" 
   MDL(Xx, 3) = "" 
 Next Xx 
 DuongTron = MDL 
End Function

Cách dùng:
Ta dùng chuột quét chọn vùng từ "G1:I16"; Ta tô màu nền cho vùng này xanh nhạt.
Sau đó, ta bấm chuột lên thanh công thức & nhập cú fáp =DuongTron()
Sau đó ta kết thúc hàm bằng tổ hợp 3 fím dành cho hàm mảng.

Rất mong các bạn thành công mĩ mãn!

*​
* *​
*​


3./ Hàm trả về tên các tập tin trong thư mục cụ thể nào đó (với đường dẫn đầy đủ):


Giả dụ chúng ta có thư mục FileSpec, và muốn liệt kê tên các tập tin trong đó lên trang tính excel, ta có thể dùng hàm mảng tự tạo như sau.
PHP:
Function FileList(FileSpec As String) As Variant 
' Returns an array of filenames that match FileSpec;' 
' If no matching files are found, it returns False.' 
    Dim FileArray() As Variant 
    Dim FileCount As Integer:             Dim FileName As String 
    On Error GoTo NoFiles 
    FileCount = 0:                        FileName = Dir(FileSpec) 
    If FileName = "" Then GoTo NoFiles 
        Loop until no more matching files are found 
    Do While FileName <> "" 
        FileCount = FileCount + 1 
        ReDim Preserve FileArray(FileCount) 
        FileArray(FileCount) = FileName 
        FileName = Dir() 
    Loop 
    FileArray(0) = FileCount 
    FileList = FileArray:                 Exit Function 
NoFiles: 
    FileList = False 
End Function

Hướng dẫn sử dụng hàm: Ta sẵn có thư mục D:\GPE\ trong máy tính; Tại vùng từ A9..K9 không chứa dữ liệu, ta có thể liệt kê các tập tin có trong có trong thư mục đó bằng cú pháp =FileList("d:\GPE\")

Cách làm cụ thể như sau:

(*) Dùng chuột tô chọn các ô vùng A9. . K9 này (Kích hoạt chúng);
(*) Bấm chuột lên thanh công thức & nhập dòng =FileList("d:\GPE\") lên nó;
(*) Sau đó nhấn tổ hợp 3 phím dành cho hàm mảng như đã đề cập bên trên.

Cần chú í thêm rằng, ô đầu tiên của hàm trả về chứa số lượng tập tin có trong thư mục đó;
Nếu tình cờ ta có số ô vừa đủ với số tập tin thì là 1 chuyện may mắn vĩ đại
Nếu ít hơn số tập tin, ta sẽ phải xóa toàn bộ (Excel không cho ta có thể xóa kết quả trong 1 vài ô của hàm mảng) & căn cứ vô số lượng tập tin ta chọn tăng số ô lên;
Nếu nhiều hơn sẽ mất mỹ quan đi 1xíu

*​
* *​
*​


4./ Trích xuất dữ liệu của 1 cá nhân theo năm sinh từ 1 danh sách trùng tên


Giả dụ cơ quan chúng ta có vài trăm nhân viên; Trong đó có một số không ít người trùng họ tên; (Xin xem bảng sau:)

G| H| I |J
TT| HoTen| NamSinh| Dvi
1| Le By| 1984| B
2 |Le My |1984 |C
3| To Ny| 1984| D
4| Do By |1985 |C
5| Ng An |1985 |A
6| To Hy |1985 |D
7| Do Na |1986 |B
8| Ng An |1986 |E
9| Le Hy |1987 |E
10| Le Na |1987 |C
11| Ng An |1987 |D
|. .| |

Nhiệm vụ sếp đề ra cho chúng ta là trích ra hồ sơ nhân viên có tên Ng An nhỏ tuổi thứ 2 trong gần chục người trùng tên đó

Để thực hiện việc này, chúc ta dùng công cụ của excel xếp dữ liệu theo cột năm sinh như trên;

Kế tiếp, ta copy hàm tự tạo sau cho vô cửa sổ VBE:
PHP:
Option Explicit 
Function DFilter(LookUpValue As String, LookUpRange As Range, _ 
   Optional Num As Byte = 1, Optional DuoiLen As Boolean = True) 
 Dim BDau As Long, KThuc As Long, Buoc As Long, jJ As Long 
 ReDim MDL(3) 
 If DuoiLen Then 
   Buoc = 1:                                 BDau = 1 
   KThuc = LookUpRange.Rows.Count 
 Else 
   BDau = LookUpRange.Rows.Count 
   Buoc = -1:                                KThuc = 1 
 End If 
 MDL(1) = LookUpValue 
 For jJ = BDau To KThuc Step Buoc 
   With LookUpRange.Cells(jJ, 2) 
      If .Value = LookUpValue Then 
         Num = Num - 1 
         If Num = 0 Then 
            MDL(2) = .Offset(, 1).Value 
            MDL(0) = .Offset(, -1).Value:    MDL(3) = .Offset(, 2).Value 
            DFilter = MDL:                   Exit Function 
         End If 
      End If 
   End With 
 Next jJ 
 If Num > 0 Then 
   MDL(0) = 0:                               MDL(2) = "Không Có Nguoi Này" 
   DFilter = MDL 
 End If 
End Function

Hướng dẫn cách dùng hàm

(*) Chọn hàng nào đó bất kỳ có trên 4 cột trống, VD 'A9:D9'
Chúng ta cũng dùng chuột kích hoạt các ô này

(*) Bấm chuột tiếp lên thanh công thức & nhập cú pháp:
=DFilter(H6,G2:J12,2)
& kết thúc bằng tổ hợp 3 phím dành cho hàm mảng để hiện kết quả

Chú ý trong cú pháp:
+ H6 là ô đang chứa tên mà chúng ta cần tìm;
+ 'G2:J12' là vùng dữ liệu mà ta yêu cầu hàm tìm trong đó (Xem như vùng dò trong VLOOKUP())
+ Tùy chọn của tham biến Num đang có trong cú pháp này có trị bằng 2, có nghĩa là tìm người nhỏ tuổi thứ 2 trong danh sách trùng tên Ng An;
Chúng ta có thể không nhập tham số này, lúc đó hàm sẽ đưa ra nhân vật đầu tiên mà nó tìm thấy;
+ Tham biến cuối chúng ta cũng bỏ qua, lúc đó hàm tự khắc biết nhiệm vụ của nó rằng phải tìm từ trên xuống;
Nếu bạn muốn hàm tìm từ dưới cùng danh sách trở lên, lúc đó ta cần nhập từ khóa 'FALSE' vô (Giống như 1 số hàm của excel cho ta tùy biến, nhỉ?!)

Chúc các bạn thành công!
 
Upvote 0
[h=2]Một số hàm mảng tự tạo (Phần I)[/h]
Mấy cái hàm mảng này e rằng phải xem lại sư phụ à!
Phương trình bậc 2 thì hơi dài. Em nghĩ có thể rút gọn lại chỉ vài dòng là đủ
--------------------------
Còn hàm lấy tên file trong thư mục thì hồi lâu lắm rồi người ta xài Dir chứ bây giờ chẳng ai xài nó cả ---> Vì nó có quá nhiều nhược điểm ---> Sư phụ cứ thử với 1 thư mục được đặt tên bằng tiếng Việt có dấu sẽ biết liền.
Chuẩn nhất là dùng Scripting.FileSystemObject hoặc lệnh DOS (cái này đã làm nhiều trên GPE rồi)
Ngoài ra, đã lấy tên file trong thư mục thì đương nhiên phải tính đến việc có lấy file trong Sub Folder hay không
 
Lần chỉnh sửa cuối:
Upvote 0
Em làm thử, mọi người kiểm tra lại giùm nhé.

Thuật toán: Sắp xếp lại các ký tự cho đúng chuẩn trước khi đưa vào hàm của anh ndu

Hàm của Thắng rất hay, tuy nhiên, hình như chỉ có 1 vấn đề ở chữ UYET65 nó rơi vào trường hợp chữ Y có dấu nặng (), Thắng thử kiểm tra lại xem nhé! Thanks.

À, kiểm thêm có chữ d9 thì thành đ nhưng D9 không ra Đ mà vẫn là D, và hầu như chỉ chuyển chữ thường, các chữ hoa không chuyển đổi.
 
Lần chỉnh sửa cuối:
Upvote 0
Em làm thử, mọi người kiểm tra lại giùm nhé.

Thuật toán: Sắp xếp lại các ký tự cho đúng chuẩn trước khi đưa vào hàm của anh ndu

Em test thử code trên win 8 64bit thì nó báo lỗi anh ah:

1) TestTelex:


2) TestVNI:


Lâu rồi không thấy các Thầy và các anh chị update thêm các hàm tự tạo.
Đề tài hay mong mọi các Thầy và các anh chị update thêm ạ!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Hàm chuyển chuỗi unicode về ký tự bàn phím kiểu gõ Telex?

Hàm chuyển chuỗi unicode về ký tự bàn phím kiểu gõ Telex?

Mình muốn trên bảng tính gõ:
=KyTuTelexTuUnicode("Công cụ tuyệt vời") Hàm trả về
"Coong cuj tuyeetj vowif"

Không biết trên GPE đã có hàm này chưa?
 
Upvote 0
Upvote 0
Hàm tách chữ

Em xin đóng góp hàm cùi bắp này:
PHP:
Function SplitWord(Str As String, C As String, VT As Long, Optional Words As Long = 1, Optional Op As Boolean = False) As String
Dim Arr As Variant, i As Long
If Op Then Str = StrReverse(Str): C = StrReverse(C)
Arr = Split(Str, C)
For i = VT To Application.WorksheetFunction.Min(VT + Words - 1, UBound(Arr) + 1)
    SplitWord = SplitWord & C & Arr(i - 1)
Next
SplitWord = Replace(SplitWord, C, "", 1, 1)
If Op Then SplitWord = StrReverse(SplitWord)
End Function
Dùng để tách chữ với nhiều tùy chọn.
Cú pháp:
Mã:
=SplitWord(Chuỗi_cần_tách, Chuỗi_phân_cách, Vị_trí_bắt_đầu, [Số_từ_cần_lấy], [Xuôi_hay_ngược])
Mã:
=SplitWord(Chuỗi_cần_tách, Chuỗi_phân_cách, Vị_trí_bắt_đầu, [Số_từ_cần_lấy], [Xuôi_hay_ngược])
[/CODE]
Anh cho em hỏi [Xuôi_hay_ngược] có nghĩa là sao ạ? anh diễn giải rõ hơn giúp em mới nhé!
 
Upvote 0
Mã:
=SplitWord(Chuỗi_cần_tách, Chuỗi_phân_cách, Vị_trí_bắt_đầu, [Số_từ_cần_lấy], [Xuôi_hay_ngược])
[/CODE]
Anh cho em hỏi [Xuôi_hay_ngược] có nghĩa là sao ạ? anh diễn giải rõ hơn giúp em mới nhé!
Xuôi là tính từ trái sang phải, ngược là tính từ phải sang trái. Mặc định là xuôi (False)
Ví dụ công thức lấy tên trong họ tên sẽ là:
Mã:
=SplitWord(A1," ",1,1,True)
Lấy 2 chữ cuối trong họ tên:
Mã:
=SplitWord(A1," ",1,2,True)
 
Upvote 0

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

Back
Top Bottom