カゲンぱぱのイイカゲンメモ帳: 2017

2017年9月22日金曜日

文字列の数字をサマリー Sum string number

数字なんだけど、文字列として表示せざるを得ない場合もある。その場合、この一列の数字を「SUM」するとうまくいかない場合があるみたい。AB4:AB100をサマリーする場合、
ソリューションとして「=VALUE(AB4)」の補助列を追加することは考えられますが、「=SUMPRODUCT(AB4:AB100 *1)」という方法もできるみたいです。

2017年9月7日木曜日

「_xlfn.IFERROR」という #NAME?エラー見えない「名前定義」にエラーがあった場合

ラベル: error, vba, 罠

下記の王なメソッドを作って、一旦エラーになっている名前定義を見える化にして、そして「名前」一覧から手動で削除して、ブックを保存

Sub delErrNames()
Dim n As name
Dim bk As Workbook
Set bk = ThisWorkbook

For Each n In bk.Names
    If n.RefersTo = "=#NAME?" Then
      n.Visible = True
    End If
Next
End Sub

2017年6月15日木曜日

Google APIを利用して、PHPで２つの住所の距離と所要時間を取得する

Google APIを利用して、PHPで２つの住所の距離と所要時間を取得するサンプル※車での移動距離と所要時間

status;

    if ( $status == 'ZERO_RESULTS' )
    {
        return FALSE;
    }
    else
    {
        $return = array('lat' => $response_a->results[0]->geometry->location->lat, 'long' => $long = $response_a->results[0]->geometry->location->lng);
        return $return;
    }
}

function GetDrivingDistance($lat1, $lat2, $long1, $long2)
{
    $url = "https://maps.googleapis.com/maps/api/distancematrix/json?origins=".$lat1.",".$long1."&destinations=".$lat2.",".$long2."&mode=driving&language=pl-PL";
    $ch = curl_init();
    curl_setopt($ch, CURLOPT_URL, $url);
    curl_setopt($ch, CURLOPT_RETURNTRANSFER, 1);
    curl_setopt($ch, CURLOPT_PROXYPORT, 3128);
    curl_setopt($ch, CURLOPT_SSL_VERIFYHOST, 0);
    curl_setopt($ch, CURLOPT_SSL_VERIFYPEER, 0);
    $response = curl_exec($ch);
    curl_close($ch);
    $response_a = json_decode($response, true);
    $dist = $response_a['rows'][0]['elements'][0]['distance']['text'];
    $time = $response_a['rows'][0]['elements'][0]['duration']['text'];

    return array('distance' => $dist, 'time' => $time);
}
//Usage:

$coordinates1 = get_coordinates('東京都三鷹市上連雀8丁目3番3号');
$coordinates2 = get_coordinates('東京都千代田区富士見2-4-1');
if ( !$coordinates1 || !$coordinates2 )
{
    echo 'Bad address.';
}
else
{
    $dist = GetDrivingDistance($coordinates1['lat'], $coordinates2['lat'], $coordinates1['long'], $coordinates2['long']);
    echo 'Distance: '.$dist['distance'].'
Travel time duration: '.$dist['time'].'';
}

こんな風に結果が表示されます：



Distance: 22,3 km

Travel time duration: 40 min

2017年6月9日金曜日

GHOST BREAKPOINT,VBA ブレークポイント設置してないのに、急にいちいち止まるようになる件

ラベル: debug, vba, 罠

解決方法
１．Debugに入って（そもそも止まらないなら、とりあえずなんかのsubを作成して、PBを置いて止める）
２．Ctrl+Pauseを2回押す
３．Playで継続
４．保存

2017年4月27日木曜日

PHONETIC関数が効かない時

ラベル: vba, エクセル関数

PHONETICという漢字をカタカナに変換してくれる関数があります。しかし何故か変換せれず漢字のまま出力されてしまう時があります。
その時は、マクロのチカラを借りる。
例えば漢字の列がA列の場合：



    Range("A:A").SetPhonetic

実行後、隣の列で「=PHONETIC("A1")」で数式を入れると変換されます

2017年3月30日木曜日

INSERT INTO 複数VALUES時のON DUPLICATE KEY UPDATEの書き方

ラベル: duplicate, insert, mysql, sql

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);

ListBoxがマウスのスクロール対応していない？！

ラベル: scroll, userform, vba

やってみたら本当だ。
幸いソリューションは既にありました。ありがとうございます。
参照：　https://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba

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

2017年3月15日水曜日

VBA DLL を正しく呼び出せません (エラー 49)

ラベル: error, vba, 罠

SubもFunctionもパラメーターの前にByValかByRefかをきちんと書こう！

2017年2月15日水曜日

VBA Arrayの論理計算、交集、並集（AND　OR）（Intersection And Union）（Logical disjunction Logical conjunction）

ラベル: array, vba

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

2017年1月31日火曜日

PHPにアップロードできるファイルサイズの上限を決めるupload_max_filesizeとpost_max_size

ラベル: php, 罠

upload_max_filesize を50Mにするだけは取りない、post_max_sizeも忘れるな！
php.iniの中にある。
アプリのConfigにも制限あるかもしれないので、要注意

登録: 投稿 (Atom)