Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
#End If
'//////////////////////////////////////////////////////////////
#If Win64 Then
Private Pri_TimerID As LongPtr
#Else
Private Pri_TimerID As Long
#End If
Public Function SplitText(Optional ByVal Expression As String) As String
If Len(Expression) = 0 Then Exit Function
On Error Resume Next
If Pri_TimerID <> 0 Then KillTimer 0&, Pri_TimerID
Static RA As Range, S As String
If VBA.TypeName(Application.Caller) = "Range" Then
SplitText = VBA.Left(Expression, 1)
If Len(Expression) > 1 Then
S = VBA.Mid(Expression, 2)
Set RA = Application.Caller
Pri_TimerID = SetTimer(0&, 0&, 0, AddressOf SplitText_callback)
End If
Else
Dim I As Integer, L As Integer
L = Len(S)
ReDim A(1 To L, 1 To 1)
For I = 1 To L: A(I, 1) = VBA.Mid(S, I, 1): Next
RA(2, 1).Resize(65535).ClearContents
RA(2, 1).Resize(L) = A
S = ""
Set RA = Nothing
End If
End Function
Private Sub SplitText_callback(): Call SplitText: End Sub
