その時は、マクロのチカラを借りる。
例えば漢字の列がA列の場合:
Range("A:A").SetPhonetic
実行後、隣の列で「=PHONETIC("A1")」で数式を入れると変換されます
Range("A:A").SetPhonetic
CREATE TABLE table_a ( a INT NOT NULL, b INT NOT NULL, c INT NOT NULL, UNIQUE (a, b) ); INSERT INTO table_a (a, b, c) VALUES (1, 2, 0),(3, 4, 5) ON DUPLICATE KEY UPDATE c = VALUES(c);
Private Sub ListBox1_MouseMove( _ ByVal Button As Integer, ByVal Shift As Integer, _ ByVal x As Single, ByVal y As Single) ' start tthe hook HookListBoxScroll End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) UnhookListBoxScroll End Sub ''''''' end Userform code ''''''' normal module code Option Explicit Private Type POINTAPI x As Long y As Long End Type Private Type MOUSEHOOKSTRUCT pt As POINTAPI hwnd As Long wHitTestCode As Long dwExtraInfo As Long End Type Private Declare Function FindWindow Lib "user32" _ Alias "FindWindowA" ( _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32.dll" _ Alias "GetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As Long) As Long Private Declare Function SetWindowsHookEx Lib "user32" _ Alias "SetWindowsHookExA" ( _ ByVal idHook As Long, _ ByVal lpfn As Long, _ ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function CallNextHookEx Lib "user32" ( _ ByVal hHook As Long, _ ByVal nCode As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" ( _ ByVal hHook As Long) As Long Private Declare Function PostMessage Lib "user32.dll" _ Alias "PostMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Private Declare Function WindowFromPoint Lib "user32" ( _ ByVal xPoint As Long, _ ByVal yPoint As Long) As Long Private Declare Function GetCursorPos Lib "user32.dll" ( _ ByRef lpPoint As POINTAPI) As Long Private Const WH_MOUSE_LL As Long = 14 Private Const WM_MOUSEWHEEL As Long = &H20A Private Const HC_ACTION As Long = 0 Private Const GWL_HINSTANCE As Long = (-6) Private Const WM_KEYDOWN As Long = &H100 Private Const WM_KEYUP As Long = &H101 Private Const VK_UP As Long = &H26 Private Const VK_DOWN As Long = &H28 Private Const WM_LBUTTONDOWN As Long = &H201 Private mLngMouseHook As Long Private mListBoxHwnd As Long Private mbHook As Boolean Sub HookListBoxScroll() Dim lngAppInst As Long Dim hwndUnderCursor As Long Dim tPT As POINTAPI GetCursorPos tPT hwndUnderCursor = WindowFromPoint(tPT.x, tPT.y) If mListBoxHwnd <> hwndUnderCursor Then UnhookListBoxScroll mListBoxHwnd = hwndUnderCursor lngAppInst = GetWindowLong(mListBoxHwnd, GWL_HINSTANCE) PostMessage mListBoxHwnd, WM_LBUTTONDOWN, 0&, 0& If Not mbHook Then mLngMouseHook = SetWindowsHookEx( _ WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0) mbHook = mLngMouseHook <> 0 End If End If End Sub Sub UnhookListBoxScroll() If mbHook Then UnhookWindowsHookEx mLngMouseHook mLngMouseHook = 0 mListBoxHwnd = 0 mbHook = False End If End Sub Private Function MouseProc( _ ByVal nCode As Long, ByVal wParam As Long, _ ByRef lParam As MOUSEHOOKSTRUCT) As Long On Error GoTo errH 'Resume Next If (nCode = HC_ACTION) Then If WindowFromPoint(lParam.pt.x, lParam.pt.y) = mListBoxHwnd Then If wParam = WM_MOUSEWHEEL Then MouseProc = True If lParam.hwnd > 0 Then PostMessage mListBoxHwnd, WM_KEYDOWN, VK_UP, 0 Else PostMessage mListBoxHwnd, WM_KEYDOWN, VK_DOWN, 0 End If PostMessage mListBoxHwnd, WM_KEYUP, VK_UP, 0 Exit Function End If Else UnhookListBoxScroll End If End If MouseProc = CallNextHookEx( _ mLngMouseHook, nCode, wParam, ByVal lParam) Exit Function errH: UnhookListBoxScroll End Function
Option Explicit Sub testUnionAndIntersection() 'Intersection And Union 'Also called 'Logical disjunction Logical conjunction 'AND OR Dim a As New Scripting.Dictionary Dim b As New Scripting.Dictionary Dim keysA As Variant Dim keysB As Variant Dim keysC As Variant Dim keysD As Variant a.Add "A", "" a.Add "B", "" a.Add "C", "" b.Add "A", "" b.Add "C", "" b.Add "X", "" keysA = a.Keys keysB = b.Keys keysC = getIntersectionSet(keysA, keysB) Debug.Print Join(keysC, ",") 'A,C keysD = getUnionSet(keysA, keysB) Debug.Print Join(keysD, ",") 'A,B,C,X Call DeleteElementAt(1, keysB) Debug.Print Join(keysB, ",") 'A,X End Sub Function getIntersectionSet(arr1 As Variant, arr2 As Variant) As Variant Dim vntTmp As Variant Dim vntRst As Variant If Not (IsArray(arr1) And IsArray(arr2)) Then Exit Function End If For Each vntTmp In arr1 If IsInArray(CStr(vntTmp), arr2) Then push vntTmp, vntRst End If Next getIntersectionSet = vntRst End Function Function getUnionSet(arr1 As Variant, arr2 As Variant) As Variant Dim vntTmp As Variant Dim vntRst As Variant If Not (IsArray(arr1) And IsArray(arr2)) Then Exit Function End If vntRst = arr1 For Each vntTmp In arr2 If Not IsInArray(CStr(vntTmp), vntRst) Then push vntTmp, vntRst End If Next getUnionSet = vntRst End Function Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1) End Function Public Sub DeleteElementAt(ByVal index As Integer, ByRef prLst As Variant) Dim i As Integer For i = index + 1 To UBound(prLst) prLst(i - 1) = prLst(i) Next ReDim Preserve prLst(UBound(prLst) - 1) End Sub Public Function push(ByVal val As Variant, ByRef arr As Variant, Optional ByVal unique As Boolean = False) As Integer Dim lngX As Long If unique Then If Not IsEmpty(arr) Then If IsArray(arr) Then For lngX = LBound(arr) To UBound(arr) If arr(lngX) = val Then push = UBound(arr) Exit Function End If Next End If End If End If If IsArray(arr) Then On Error GoTo initArray ReDim Preserve arr(UBound(arr) + 1) Else initArray: ReDim arr(0) End If If VarType(val) = 9 Then '9 is object Set arr(UBound(arr)) = val Else arr(UBound(arr)) = val End If push = UBound(arr) End Function
connect.CursorLocation = 3 'クライアントカーソルにする
Set rs = execQuery(cn, sql, , adOpenKeyset, adLockOptimistic)
debug.print rs.RecordCount