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

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

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

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

ADOレコーダーがあるのに、RecordCountが「-1」の場合の対処

レコーダーがあるのに、RecordCountが「-1」の場合の対処

connect.CursorLocation = 3 'クライアントカーソルにする
Set rs = execQuery(cn, sql, , adOpenKeyset, adLockOptimistic)
debug.print rs.RecordCount


列の値を一括更新（LOOP、Query、補助列を使わず！）

列の値を一括更新するときは、vbaで行ごとLOOPを書くか、ADODBでUpdateクエリーを書くか、補助列を挿入して数式で計算させるかでも、最近「Evaluate」知ったですよ

Range("B:B").Value = Evaluate(Range("B:B").Address & "*10")

これは神メソッドですね。気を付けなければならないのは、空欄が0に評価されてしまう、数字以外の文字列がエラーになる。

メソッド化にすると

Sub updateRangeValues(ByRef rg As Range, strFormula As String, Optional strFormat As String = "")
    rg.Worksheet.Activate '←ここが重要！！、なぜかこうしないと全部0と評価してしまう
    If strFormat <> "" Then
        rg.NumberFormatLocal = strFormat
    End If
    rg.Value = Application.Evaluate(rg.Address & strFormula)
    Application.Calculate
    Do While Application.CalculationState <> xlDone '←念のため、計算が終わまでDoEvents
        DoEvents
    Loop
End Sub

使い方：

Call updateRangeValues(Range("A1:A1000"),"*10.1","#.00")

LOOP、Query、補助列を使わずに、"A1:A1000"列の数値を全部＊10.1,書式を小数点二桁にする


もう少し複雑な数式でもいけるらしい

Sub nn()
Dim rg As Range
Set rg = ThisWorkbook.Worksheets(1).Range("C1:C36")
strFormula = "=IF(" & rg.Address & "= """",""IS EMPTY""," & rg.Address & "*10)"
rg.Value = Application.Evaluate(strFormula)
End Sub

SVN Error handling externals definition for


[root@abc my_production]# svn up
svn: 警告: Error handling externals definition for 'lib/wired':
svn: 警告: OPTIONS (URL: 'http://svn.notexisted.jp/repos/wired/php/branches/0.2.x/lib'): サーバに接続できませんでした (http://svn.notexisted.jp)
リビジョン 1718 です。


svn propdel --recursive svn:externals .
svn ci -m"svn propdel --recursive svn:externals"

svn up
U lib
svn: 警告: Error handling externals definition for 'lib/wired':
svn: 警告: OPTIONS (URL: 'http://svn.notexisted.jp/repos/wired/php/branches/0.2.x/lib'): サーバに接続できませんでした (http://svn.notexisted.jp)
リビジョン 1719 に更新しました。


ado,sqlのunderline…自分かバカすぎで笑えない

sqlではアンダーライン"_"は、任意の一文字って意味か、ADOでもMysqlでも...、やられた、ADOでは"[]"でエスケープする、sqlでは"\"でエスケープする。
正規表現とごっちゃまぜしちゃダメよ。(;_;)


SELECT * FROM tbl WHERE tname LIKE 'abc[_]%'

SQL

SELECT * FROM tbl WHERE tname LIKE 'abc\_%'


VBAのRoundの罠

ROUND(38.5)
結果：38

ROUND(39.5)
結果：40

「銀行家の丸め (bankers' rounding)」、「銀行丸め」ともいう。
5が切り捨てられたり切り上げられたりするので「五捨五入」と呼ばれたり、
端数がちょうど0.5の場合に整数部分が偶数なら切り捨て奇数なら切り上げる
ので「偶捨奇入」と呼ばれたりもする。



本当の「四捨五入」したい場合は

WorksheetFunction.Round()

が有効だそうです。
しかし、ADODB,Jet.OLEDBなどでQuery（クエリー）で運用時は使えないので

sql = "UPDATE MyTable SET `Ammount` = ROUND(35*1.1)"
Call csv_cn.Execute(sql)

=ROUND(38.5) = 38

↓

sql = "UPDATE MyTable SET `Ammount` = FORMAT(35*1.1,""#"")"
Call csv_cn.Execute(sql)

=ROUND(38.5) = 39

ちなみに、小数点以下2位の四捨五入は

sql = "UPDATE MyTable SET `Ammount` = FORMAT(35*1.111,""#.00"")"
Call csv_cn.Execute(sql)