Viết hàm tự tạo theo kiểu Excel 365

[Ngô Hải Đăng]

Nghiên cứu trên diễn đàn thì phát hiện được cái Application.Caller và sau đây là ý tưởng của mình:
1. Code trên ThisWorkbook

Option Explicit

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    If IsUDF Then
        SetResult
        rCaller.Formula = sFormula
    End If
End Sub

Private Sub SetResult()
    Dim r0&, c0&
    On Error Resume Next
    r0 = UBound(aResult, 1) - LBound(aResult, 1)
    c0 = UBound(aResult, 2) - LBound(aResult, 2)
    On Error GoTo 0
    If c0 = 0 Then
        rCaller.Resize(1, r0 + 1) = aResult
    Else
        rCaller.Resize(r0 + 1, c0 + 1) = aResult
    End If
End Sub

2. Code trên Module

Option Explicit

Public IsUDF As Boolean
Public rCaller As Range
Public aResult As Variant
Public sFormula As String

Function MyUDF()
    If IsUDF Then
        MyUDF = aResult
        IsUDF = False
        Set rCaller = Nothing
        If IsArray(aResult) Then Erase aResult Else aResult = Empty
    Else
        IsUDF = True
        Set rCaller = Application.Caller
        sFormula = rCaller.Formula
        
        'Dim tmp As String: tmp = "1 GIA TRI"
        'Dim tmp: tmp = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
        Dim tmp(10, 15) As Long
        aResult = tmp
    End If
End Function

3. Gõ =MyUDF() trên Sheet để test.

Có thể thử với kết quả là 1 giá trị, mảng 1 chiều và mảng 2 chiều. Mong được học hỏi thêm kinh nghiệm từ mọi người.

 

[phuongnam366377]

Bạn xem file nhé.

gần ra rồi đấy ... cố giắng thêm tẹo nữa là ra thôi

 

[Tuanba1992]

Vì cái này là sẵn có của excel nên phải "Ctr Shift Enter" nó mới trả về mảng, còn nếu mình tự tạo hàm mảng riêng thì không cần.
Bạn thử gõ công thức này tại ô A20 xem

=HDFillResult(A1:K11)

Sau đó thử với công thức =A1:K11 sẽ thấy sự khác biệt.

em test trên 365 cần ctrl+shift+365 mới ra không sẽ lỗi #SPILL!

Bài đã được tự động gộp: 19/11/20

Em cũng có tý hàm tự tạo gửi mọi người dùng thử:

Gitiho.zip

drive.google.com

Hướng dẫn

 

[Hai Lúa Miền Tây]

Bác thử code này xem, tuy nhiên chỉ mới là bước đầu thôi, fill được cái mảng lên sheet.

Option Explicit

Public rCaller As Range
Public aResult
Public nCount As Byte

Function HDFillResult(iArray, Optional iDynamic As Boolean)
    On Error GoTo Reset
    Select Case nCount
        Case Is = 0:
            nCount = 1
            If iDynamic Then Application.Volatile
            If TypeName(iArray) = "Range" Then
                Set aResult = iArray
            Else
                If IsArray(aResult) Then
                  aResult = iArray
                Else
                  aResult = iArray
                End If
            End If
            Set rCaller = Application.Caller
            HDFillResult = Evaluate(rCaller.Formula)
        Case Is = 1:
            nCount = 2
            SetResult2 rCaller, aResult
            HDFillResult = aResult
      
        Case Else:
            HDFillResult = aResult
            GoTo Reset
    End Select
    Exit Function
Reset:
    HDResetAll
End Function

Function HDResetAll() As Boolean
    HDResetAll = rCaller Is Nothing
    Set rCaller = Nothing
    If TypeName(aResult) = "Range" Then
      Set aResult = Nothing
    Else
      If IsArray(aResult) Then Erase aResult Else aResult = Empty
    End If
    nCount = Empty
End Function

Private Sub SetResult2(iCell As Range, iArray)
    Dim r0&, c0&
    GetSizeArray iArray, r0, c0
    If r0 + c0 = 2 Then Exit Sub
    Application.ScreenUpdating = False
    On Error GoTo ResetScreenUpdate
    If TypeName(iArray) = "Range" Then
        If c0 > 1 Then iCell.Resize(1, c0 - 1).Offset(0, 1) = iArray.Resize(1, c0 - 1).Offset(0, 1).Value
        If r0 > 1 Then iCell.Resize(r0 - 1, c0).Offset(1, 0) = iArray.Resize(r0 - 1, c0).Offset(1, 0).Value
    Else
        If r0 = 1 Then
            If c0 > 2 Then
                iCell.Resize(1, c0 - 1).Offset(0, 1) = iArray
                iCell.Resize(1, c0 - 2).Offset(0, 1) = iCell.Resize(1, c0 - 2).Offset(0, 2).Value
            End If
            iCell.Offset(0, c0 - 1) = Application.Index(iArray, 1, c0)
        Else
            iCell.Resize(r0 - 1, c0).Offset(1, 0) = iArray
            If r0 > 2 Then iCell.Resize(r0 - 2, 1).Offset(1, 0) = iCell.Resize(r0 - 2, 1).Offset(2, 0).Value
            If c0 > 1 Then iCell.Resize(r0 - 1, c0 - 1).Offset(0, 1) = iCell.Resize(r0 - 1, c0 - 1).Offset(1, 1).Value
            iCell.Offset(r0 - 1, 0).Resize(1, c0) = Application.Index(iArray, r0, 0)
        End If
    End If
    Exit Sub
ResetScreenUpdate:
    Application.ScreenUpdating = True
End Sub

Private Sub GetSizeArray(iArray, iRows As Long, iColumns As Long)
    If TypeName(iArray) = "Range" Then
        iRows = iArray.Rows.Count
        iColumns = iArray.Columns.Count
    Else
        iColumns = -1
        On Error Resume Next
        iRows = UBound(iArray, 1) - LBound(iArray, 1)
        iColumns = UBound(iArray, 2) - LBound(iArray, 2)
        If iColumns = -1 Then iColumns = iRows: iRows = 0
        iRows = iRows + 1: iColumns = iColumns + 1
    End If
End Sub

Cám ơn bạn, thật ra cũng đã khá lâu tôi cũng đã bị nó làm cho tôi thêm nhiều sợi tóc bạc.

 

[Hoàng Nhật Phương]

Cám ơn bạn, thật ra cũng đã khá lâu tôi cũng đã bị nó làm cho tôi thêm nhiều sợi tóc bạc.

Tóc bạc bao nhiêu phong độ bấy nhiêu anh ạ

 

[phuongnam366377]

Trên GPE này có thành viên x gì đó lập nhiều thớt hỏi diết là File đang mở xong vô tình mở lại thì Bill thông báo ... vậy có cách gì tắt hay xử lý nó vvv
Mới vô tình mở trên Office 365 như thế xong ... thấy nó IM RE ko có thông báo gì hết => muốn mở lại chính file đó n lần ok hết
Ai đang xài office 365 thử xem có đúng không !!

Xin trân trọng thông báo với thành Viên x gì đó chuyển qua Office 365 mà xài đi khỏi đau đầu suy nghĩ cái vụ mở file rồi xong mở lại nữa vvv
trên Office 365 có rất nhiều thứ hay và hiện đại đấy ... cứ mò tiếp đi là thấy

 

[befaint]

Trên GPE này có thành viên x gì đó lập nhiều thớt hỏi diết là File đang mở xong vô tình mở lại thì Bill thông báo ... vậy có cách gì tắt hay xử lý nó vvv
Mới vô tình mở trên Office 365 như thế xong ... thấy nó IM RE ko có thông báo gì hết => muốn mở lại chính file đó n lần ok hết
Ai đang xài office 365 thử xem có đúng không !!

Xin trân trọng thông báo với thành Viên x gì đó chuyển qua Office 365 mà xài đi khỏi đau đầu suy nghĩ cái vụ mở file rồi xong mở lại nữa vvv
trên Office 365 có rất nhiều thứ hay và hiện đại đấy ... cứ mò tiếp đi là thấy

Hình như Excel 2013 trở lên là ngon lành như vậy rồi anh.
Excel 2019 thì chắc chắn luôn.

Thành viên đó dùng Excel 2010, bởi sau khi tét trong phòng thí nghiệm các kiểu thì các phiên bản khác đều không ngon bằng.

 

[phuongnam366377]

Hình như Excel 2013 trở lên là ngon lành như vậy rồi anh.
Excel 2019 thì chắc chắn luôn.

Thành viên đó dùng Excel 2010, bởi sau khi tét trong phòng thí nghiệm các kiểu thì các phiên bản khác đều không ngon bằng.

Sao hôm Mạnh còn xài Office 2016x64 nó vẫn còn vậy đấy . thử nhiều lần rồi file đang mở xong bấm mở lại nó báo thế

Bill thoáng kinh cho Mạnh tạo cả ngàn user đấy ... đoán thôi nhé chắc bill muốn phổ biến sâu và rộng cho ai cũng xài Office 365 hết hay sao ý

Bài đã được tự động gộp: 19/11/20

Tự nhiên hôm trước còn là sinh viên nay Bill thăng lên chức giáo viên nhanh thế gói E3



Tiếng việt nè là giảng viên luôn mới Kinh

 

[Ngô Hải Đăng]

Co giãn cũng tàm tạm, giờ làm cách nào để khi xóa công thức thì nó xóa nguyên cả mảng.

 

[Ngô Hải Đăng]

Một cách lấy dữ liệu từ file đang đóng, ai sử dụng 365 có thể thử.

 

[Kiều Mạnh]

Thấy người ta úp video diết cũng mới tập làm 1 cái Hàm gán dữ liệu kiểu Office 365 mà không phải lấy dữ liệu cùng File hay khác file trên cùng 1 máy

Mà lấy dữ liệu qua Internet cho nó vui vẻ chút ... tăng chút khí thế cho các bạn trẻ học code .... già như Mạnh còn mò ra mà ... các Bạn trẻ cố giắng thêm chút là ra đấy he

Cấu trúc hàm nó cũng đơn giản lắm

IP: 192.168.1.9
Port: 8181
SQL: select * from DataBaseNhap
Tiêu Đề: TRUE

Sử dụng chỉ việc gõ : A10 = SQLServer(IP,Port,SQL,true) Enter cái là xong
Nó Share nguyên 1 Folder hay 1 ổ dĩa đấy trong đó có bao nhiêu File thích lấy gì nó lấy hết ( Cái quan trọng là viết lại code chút thôi )

Xin mời ta lại xem phim

 

[Ngô Hải Đăng]

Thấy người ta úp video diết cũng mới tập làm 1 cái Hàm gán dữ liệu kiểu Office 365 mà không phải lấy dữ liệu cùng File hay khác file trên cùng 1 máy

Mà lấy dữ liệu qua Internet cho nó vui vẻ chút ... tăng chút khí thế cho các bạn trẻ học code .... già như Mạnh còn mò ra mà ... các Bạn trẻ cố giắng thêm chút là ra đấy he

Cấu trúc hàm nó cũng đơn giản lắm

IP: 192.168.1.9
Port: 8181
SQL: select * from DataBaseNhap
Tiêu Đề: TRUE

Sử dụng chỉ việc gõ : A10 = SQLServer(IP,Port,SQL,true) Enter cái là xong
Nó Share nguyên 1 Folder hay 1 ổ dĩa đấy trong đó có bao nhiêu File thích lấy gì nó lấy hết ( Cái quan trọng là viết lại code chút thôi )

Xin mời ta lại xem phim

Giờ em mới phát hiện là nếu viết addin bằng VBA excel thì có thể lợi dụng worksheet trong addin để tính toán.

 

[Kiều Mạnh]

Giờ em mới phát hiện là nếu viết addin bằng VBA excel thì có thể lợi dụng worksheet trong addin để tính toán.

Thì cứ quậy các kiểu đi là sẻ biết thôi

 

[Kiều Mạnh]

úi dào sau 2 năm tui mới ngộ ra cách viết trên Delphi ... xong rồi mới thấy như ăn kẹo mút
ko cần sự kiện + linh tinh cua ... viết 1 cái Hàm tạm keo là ResizeArrayA thui
xong gán bất cứ cái Array nào đã tính toán xong vào đó là nó trả Array lên Range thôi
Link sau bài 1363

AI muốn lập trình DLL cho Excel và các loại bằng Delphi thì xem video này nhé!

Đây là video hướng dẫn cách tạo DLL trên Delphi nhưng sử dụng trong VBA, Excel. Đây là phương pháp lập trình chuyên nghiệp nhưng không phải là khó. Giúp bạn bảo mật code của phần mềm tốt hơn. Loạt video hướng dẫn lập trình Delphi cơ bản của mình tại đây...

www.giaiphapexcel.com