Ngô Hải Đăng
Thành viên hoạt động
- Tham gia
- 31/8/17
- Bài viết
- 180
- Được thích
- 244
- Donate (Paypal)
- Donate (Momo)
- Giới tính
- Nam
Ứng dụng Class Module để viết hàm UDF_ArrayFormula
Hàm này sẽ hỗ trợ hiển thị kết quả là mảng trên trang tính. Các phiên bản Excel đã hỗ trợ sẵn việc hiển thị mảng thì không cần dùng hàm này. Một số công thức phải gõ Ctrl+Shitf+Enter tại ô chứa công thức thì mới hiện thị kết quả.
Đầu tiên là tạo Class Module tên UDSF.
PHP:
Option Explicit
Private cParam As New Collection
Private cCaller As New Collection
Private fCalc As Boolean
Private WithEvents Worksheet As Excel.Worksheet
Private WithEvents Workbook As Excel.Workbook
Sub Link(ParamArray iSubParam())
If fCalc Then Exit Sub
If TypeName(Application.Caller) <> "Range" Then Exit Sub
cCaller.Add Application.Caller
cParam.Add iSubParam
Set Worksheet = Application.Caller.Worksheet
If Workbook Is Nothing Then Set Workbook = Application.ThisWorkbook
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Application.CountA(Target) = 0 Then
Set Workbook = Nothing
Dim r As Range, aX
Set r = Target.Find("*", , xlComments)
On Error Resume Next
While Not r Is Nothing
aX = Split(r.Comment.Text, "$")
r.Resize(aX(1), aX(2)) = Empty
r.Comment.Delete
Set r = Target.Find("*", , xlComments)
Wend
Set Workbook = Application.ThisWorkbook
End If
End Sub
Private Sub Worksheet_Calculate()
Set Worksheet = Nothing
Set Workbook = Nothing
fCalc = True
On Error GoTo Reset
While cParam.Count > 0
Application.Run cParam(1)(0), cParam(1), cCaller(1)
cCaller.Remove 1
cParam.Remove 1
Wend
Reset:
Set Workbook = Application.ThisWorkbook
Set cParam = Nothing
Set cCaller = Nothing
fCalc = False
End SubTiếp theo là tạo 1 Module để sử dụng Class Module này.
PHP:
Option Explicit
Public oUDSF As New UDSF
Function UDF_ARRAYFORMULA(iArray)
UDF_ARRAYFORMULA = iArray
oUDSF.Link "UDS_ARRAYFORMULA", UDF_ARRAYFORMULA
End Function
Private Sub UDS_ARRAYFORMULA(iParam, iCaller As Range)
Dim sF$: sF = iCaller.Formula
Dim fA As Boolean: fA = iCaller.HasArray
Dim x&, y&, aX: x = 1: y = -1
On Error Resume Next
x = UBound(iParam(1)) - LBound(iParam(1)) + 1
y = UBound(iParam(1), 2) - LBound(iParam(1), 2) + 1
On Error GoTo 0
If y = -1 Then y = x: x = 1
If Not iCaller.Comment Is Nothing Then
aX = Split(iCaller.Comment.Text, "$")
iCaller.Resize(aX(1), aX(2)) = Empty
iCaller.Comment.Delete
End If
iCaller.Resize(x, y) = iParam(1)
iCaller.AddComment "AF$" & x & "$" & y
iCaller.Comment.Shape.Height = 16
iCaller.Comment.Shape.Width = 64
If fA Then
iCaller.FormulaArray = sF
Else
iCaller.Formula = sF
End If
End SubGõ công thức =UDF_ARRAYFORMULA({1,2,3;4,5,6;7,8,9}) trên trang tính và xem kết quả.
Cập nhật: Thử xóa ô chứa công thức và xem kết quả.
Chỉnh sửa lần cuối bởi điều hành viên:
