表データを操作する５つの方法 ＋ １

前回は５つの方法で表データを操作してみた。

www.excellovers.com

次の抽出に進む前にもう１つ集計方法を追加してみる。

SQLite For Excel

当blogではおなじみSQLite For Excelを候補に加えます。

今回の事例のようなExcelのデータを操作するためには使用していません。
しかし自分の業務には色々なところに組み込んであります。
下記のようなメリットを感じています。

• インストールが不要(超重要)
• GBクラスのデータを保管できる
• SQLが使用できる

コード

Sub 単純貼付け_SQLite()
     Dim myDbHandle As Long
     Dim myStmtHandle As Long
     
'時間計測開始-----------------------------------------
     Worksheets("Sheet2").Cells.Clear
     Dim StartTime As Double: StartTime = Timer
CheckTimePrintOut "SQLite：データ取り込み開始：", Timer
     
     SQLite3Initialize
     SQLite3OpenV2 "test.db3", _
          myDbHandle, SQLITE_OPEN_READWRITE + SQLITE_OPEN_MEMORY, ""
     SQLite3PrepareV2 myDbHandle, "create table test(名前 text,ふりがな text,アドレス text,性別 text,年齢 Integer,誕生日 text)", myStmtHandle
     SQLite3Step myStmtHandle
     SQLite3Finalize myStmtHandle
CheckTimePrintOut "SQLite：InMemoryDB作成：", Timer
'SQLiteデータ取り込み-----------------------------------------
     SQLiteBeginTransaction myDbHandle
     Dim myListObj As ListObject: Set myListObj = Worksheets("Sheet1").ListObjects("t_個人情報")
     Dim myRngs As Range: Set myRngs = Worksheets("Sheet1").Range("A1").CurrentRegion
     Dim myRng As Range
     Dim mySQL As String
     Dim i As Long
     For Each myRng In Intersect(myRngs, Worksheets("Sheet1").Range("A2:A" & Rows.Count))
          mySQL = "insert into test values("""
          mySQL = mySQL & myRng.offset(, 0).Value & ""","""
          mySQL = mySQL & myRng.offset(, 1).Value & ""","""
          mySQL = mySQL & myRng.offset(, 2).Value & ""","""
          mySQL = mySQL & myRng.offset(, 3).Value & ""","
          mySQL = mySQL & myRng.offset(, 4).Value & ","""
          mySQL = mySQL & myRng.offset(, 5).Value & """)"
          
          SQLite3PrepareV2 myDbHandle, mySQL, myStmtHandle
          SQLite3Step myStmtHandle
          SQLite3Finalize myStmtHandle
     Next
     SQLiteCommitTransaction myDbHandle
     CheckTimePrintOut "データ取り込み終了："
'データ貼り付け-----------------------------------------
     mySQL = "select * from test"
     Dim myData() As Variant
     SQLiteSelect mySQL, myDbHandle, True, myData
     CheckTimePrintOut "配列転記終了："
     Worksheets("Sheet2").Range("A1").Resize(UBound(myData), UBound(myData, 2)).Value = myData
     CheckTimePrintOut "データ貼り付け終了："
'クロージング-----------------------------------------
     
     CheckTimePrintOut "クロージング："
     Debug.Print "全処理時間:" & Timer - StartTime
End Sub

’--------------------------------------------
Function SQLiteSelect(SQL As String, dbHandle As Long, Header As Boolean, ByRef ArrayDatas() As Variant) As Variant

     If Left(SQL, 6) <> "select" Then
        ArrayDatas = Array()
        SQLiteSelect = "NotSelectSQL"
        Exit Function
     End If
     
'レコード件数を取得する--------------------------------------------
     Dim myStmtHandle As Long
     Dim ReturnValue As Variant
     ReturnValue = SQLite3PrepareV2(dbHandle, "select count(*) from (" & SQL & ")", myStmtHandle)

'SQL文に不備がある場合
     If ReturnValue = SQLITE_ERROR Then
        ArrayDatas = Array()
        Exit Function
     End If
     
'レコード件数を変数へ
     ReturnValue = SQLite3Step(myStmtHandle)
     Dim MaxRecordCount As Long: MaxRecordCount = ColumnValue(myStmtHandle, 0, SQLite3ColumnType(myStmtHandle, 0))
     SQLite3Finalize myStmtHandle
     
     If MaxRecordCount = 0 Then
        ArrayDatas = Array()
        Exit Function
     End If

     ReturnValue = SQLite3PrepareV2(dbHandle, SQL, myStmtHandle)
     ReturnValue = SQLite3Step(myStmtHandle)
     
     Dim colCount As Long
     colCount = SQLite3ColumnCount(myStmtHandle)
     ReDim ArrayDatas(MaxRecordCount + Header * -1, colCount - 1)

'レコードデータを変数へ転記----------------------------------------
'列毎のデータタイプを配列へ(データ取得時のオブジェクトへのアクセス回数軽減？)
'引数HeaderがTrueなら抽出データのヘッダーを配列の１行目に追加
     Dim i As Long
     Dim n As Long
     Dim colType() As Long
     ReDim colType(colCount - 1)
          
     For n = 0 To colCount - 1
          colType(n) = SQLite3ColumnType(myStmtHandle, n)
          If Header Then ArrayDatas(i, n) = SQLite3ColumnName(myStmtHandle, n)
     Next
     i = i - Header
CheckTimePrintOut "ヘッダーを配列に転記："

     Do Until ReturnValue = SQLITE_DONE Or ReturnValue = SQLITE_MISUSE
          For n = 0 To colCount - 1
               ArrayDatas(i, n) = ColumnValue(myStmtHandle, n, colType(n))
          Next
          i = i + 1
          ReturnValue = SQLite3Step(myStmtHandle)
     Loop
CheckTimePrintOut "データを配列に転記："
End Function

'--------------------------------------------
#If Win64 Then
Function ColumnValue(ByVal stmtHandle As LongPtr, ByVal ZeroBasedColIndex As Long, ByVal SQLiteType As Long) As Variant
#Else
Function ColumnValue(ByVal stmtHandle As Long, ByVal ZeroBasedColIndex As Long, ByVal SQLiteType As Long) As Variant
#End If
    Select Case SQLiteType
        Case SQLITE_INTEGER:
            'SQLite3ColumnInt32→SQLite3ColumnDouble　Excel上Long型で処理されて桁あふれする為
            ColumnValue = SQLite3ColumnDouble(stmtHandle, ZeroBasedColIndex)
        Case SQLITE_FLOAT:
            ColumnValue = SQLite3ColumnDouble(stmtHandle, ZeroBasedColIndex)
        Case SQLITE_TEXT:
            ColumnValue = SQLite3ColumnText(stmtHandle, ZeroBasedColIndex)
        Case SQLITE_BLOB:
            ColumnValue = SQLite3ColumnText(stmtHandle, ZeroBasedColIndex)
        Case SQLITE_NULL:
            ColumnValue = Null
    End Select
End Function

'--------------------------------------------
Private Function ResultNumtoStr(ResultNumber As Long) As String
     Dim ReturnValue As String
     
     Select Case ResultNumber
          Case 1
               ReturnValue = "SQLITE_ERROR"
          Case 14
               ReturnValue = "SQLITE_CANTOPEN"
          Case 21
               ReturnValue = "SQLITE_MISUSE"
          Case Else
               ReturnValue = "StatusNumber:" & ResultNumber
     End Select
     ResultNumtoStr = ReturnValue
End Function

処理時間

機能	配列	Collection	Dictionary	Recordset	ArrayList	SQLite
データ取り込み	0.07	0.77	2.01	2.17	2.04	62.52
データ貼り付け	3.10	3.46	5.31	0.71	3.81	2.15
全処理時間	3.18	4.29	7.40	2.92	5.86	64.68

まとめ

いやぁコードが長いうえに圧倒的に遅い。
この用途に使うもんじゃないですね。
次回からはこのSQLiteを含めた６つの方法で試してみます。