array(“”,””)は配列
array(“”)も配列
split(“,”,”,”)は配列
なので
split(“”,”,”)=array(“”)
でこれも配列と思いきやさにあらず。
split(“”,”,”)は空配列
selectした結果でupdate; accessの場合
以前
update tableA set
columnA=tableB.columnB
from tableA
inner join tableB
on tableA.ID=tableB.ID
とクエリ書いたけど、これはaccessのクエリでは通用しなかった。
sqlserverとは違うようです。
accessでは
update tableA inner join tableB on tableA.ID=tableB.ID
set
columnA=tableB.columnB
こちらが自然な気がする
XMLファイルを読み込むVBA
access VBA 遅延バインディング でとなると難しいです
https://vbaexcel.slavesystems.com/vba/?p=603 を参考にさせてもらい、accessのVBAなので二次元配列にノード名と値を入れ込む
再帰プロシージャ、難しい。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 |
Option Compare Database Private aryxml() As String Private ixml As Long Public Function parsexml() Dim XML Dim strfilepath As String Dim returnary As Variant Dim returnvalue As Integer WizHook.Key = 51488399 returnvalue = WizHook.GetFileName(0, "", "", "", strfilepath, "", "すべてのファイル (*.*)|*.*", 0, 0, 8, True) WizHook.Key = 0 returnary = Array(returnvalue, strfilepath) If returnary(0) = -302 Then Exit function End If if not instr(returnary(1),chr(9))=0 then MsgBox “選択は一つにお願いします。” Exit function End if 'Debug.Print returnary(1) Set XML = CreateObject("MSXML2.DOMDocument.6.0") XML.Load (returnary(1)) If (XML.parseerror.errorcode <> 0) Then MsgBox XML.parseerror.reason, vbCritical End If ixml = 0 Call getchildren(XML) 'Debug.Print "ubound " & UBound(aryxml, 2) 'Debug.Print aryxml(0, 0) & " " & aryxml(0, 1) & " " & aryxml(0, 2) 'Debug.Print aryxml(1, 0) & " " & aryxml(1, 1) & " " & aryxml(1, 2) Set XML = Nothing ‘Erase aryxml End Function Private Function getchildren(xmlparent As Variant) On Error Resume Next Dim e For Each e In xmlparent.childnodes If e.childnodes.length = 0 Then If Not xmlparent.basename = "" Then ReDim Preserve aryxml(1, ixml) aryxml(0, ixml) = xmlparent.basename aryxml(1, ixml) = e.text End If Else Call getchildren(e) End If Next ixml = ixml + 1 End Function |
recordsetclone
先日、accessのフォームを作成中
表示されたデータでテーブルを更新しようと・・。
ソースのクエリが複雑で面倒くさい。
フォームの値をそのまま使おうと、こういう時はme.recordsetだよなと・・
しかし動作時にカーソルが動きすぎてみっともない。で、この時ハッとrecordsetcloneてこういう時のためににあるのかな？と気が付きました。
違っているかもしれないですが書き留めておきます。
format関数（3回目ぐらい）
format関数はvba、SqlServer、VB.netにありますが少し入力値に違いありです
vbaは文字でも数字でも日付型でも良いみたい
format(“41″,”000”) は041
だけど
SqlServer、VB.netの入力値は数字または日付型のみ許されるようです。
sqlserverでは
format(cast(’41’ as int),’000′)
としないと思った通りに返ってこない
知らなかったがVBAで
strconv(“abc”,vbUpperCase) は ABC だけど
format(“abc”,”>”) も ABC
知らなくても良さそうだが書いておきます。
VBAからExcelを操作2
前回の
|
1 2 3 4 5 6 7 |
Call Ary関数 For j = 0 To UBound(Ary関数, 1) For I = 1 To UBound(Ary関数, 2) objCells(j + 1, I + 2) = Ary関数(j, I) Next Next |
この部分耐えがたい遅さです。
vb.netの二次元配列はまあまあ我慢できますがVBAはデータが多くなるとだめです。
一次元目の要素（項目数）が少なければ一次元配列を並べた方が速いです。
さらに速いのはレコードセットから直接ループさせつつ書き込む。
すごく速いのでvb.netもデータテーブルから直接書き込むようにしました。
プロセスも今の所残っていません。コードが冗長になりますけど。
VBAからExcelを操作
VBAからもできるでしょうと思ったけど・・
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 |
Public Function Excelbinding() Dim objExcel As Object Dim objExApp As Object Dim objWorkbook As Object Dim objWorkbooks As Object Dim fpath As String fpath = "xlsファイルのパス" Dim objSheets As Object Dim objSheet1 As Object Dim objSheet2 As Object Dim objSheet3 As Object Dim objCells As Object Dim I As Integer Dim j As Integer Set objExcel = CreateObject("Excel.Application") Set objExApp = objExcel.Application objExApp.Visible = True Set objWorkbooks = objExApp.Workbooks Set objWorkbook = objWorkbooks.Open(fpath) objExcel.DisplayAlerts = False 'System.Threading.Thread.Sleep(5000) Set objSheets = objExApp.Sheets Set objSheet1 = objSheets(1) objSheet1.Delete Set objSheet1 = objSheets(1) Set objSheet2 = objSheets("シート名") objSheet2.Copy Before:=objSheet1 Set objSheet3 = objSheets("シート名 (2)") '前回と同じコピーに流し込む Set objCells = objSheet3.Cells Call Ary関数 For j = 0 To UBound(Ary関数, 1) For I = 1 To UBound(Ary関数, 2) objCells(j + 1, I + 2) = Ary関数(j, I) Next Next objWorkbook.SaveAs (fpath) objExApp.Quit objExcel.DisplayAlerts = True Set objCells = Nothing Set objSheets = Nothing Set objSheet1 = Nothing Set objSheet2 = Nothing Set objSheet3 = Nothing Set objWorkbook = Nothing Set objWorkbooks = Nothing Set objExApp = Nothing Set objExcel = Nothing end function |
今までは意識してなかったけどVBAではオブジェクト解放は要らない？
プロセスは残らないが・・
とりあえずset=nothingで安心することに。
選択ソート 二次元配列
ついでに選択ソートも
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 |
Dim Ary() As String For I = 0 To myDIC.Count - 1 ReDim Preserve Ary(1, I) Ary(0, I) = myDIC.keys()(I) Ary(1, I) = myDIC.items()(I) Next I 'Dictionaryから二次元配列に '以下ソート Dim i As Long, j As Long Dim Max As Double, flag As Double Dim newA0 As Long, newB0 As Long _ , newA1 As Double, newB1 As Double, Mark As Long For I = 0 To UBound(Ary, 2) - 1 flag = CDbl(Ary(1, I)) Max = CDbl(Ary(1, I)) Mark = I For j = 1 To UBound(Ary, 2) - I If Max < CDbl(Ary(1, I + j)) Then Max = CDbl(Ary(1, I + j)) Mark = I + j End If Next j newA0 = Ary(0, Mark) newA1 = CStr(Max) newB0 = Ary(0, I) newB1 = CStr(flag) If Not Mark = I Then Ary(0, I) = newA0 Ary(1, I) = newA1 Ary(0, Mark) = newB0 Ary(1, Mark) = newB1 End If Next I |
QuickSort 二次元配列
もともとはDictionaryでソートする必要があったので配列のソートを調べたのでした
dictionaryに入っているkeyとitemを二次元配列にしてソートする
もっと良い方法があると思いますが・・とりあえず
関数化したけど要素で型変換必要なので意味がなかった
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 |
Public Function QuickSortB(ByRef ParamAry As Variant) As Variant 'paramaryは二次元配列 Dim newAry() As String Dim I As Long Dim j As Long Dim K As Long Dim Anker As Date 'ソートしたい Dim Bnker As Long Dim TopAry() As String Dim BtmAry() As String j = 0 K = 0 If Not UBound(ParamAry, 2) >= 0 Then 'トラップ Exit Function End If Bnker = CLng(ParamAry(0, 0)) Anker = CDate(ParamAry(1, 0)) For I = 1 To UBound(ParamAry, 2) If CDate(ParamAry(1, I)) < Anker Then ReDim Preserve TopAry(1, j) TopAry(0, j) = ParamAry(0, I) TopAry(1, j) = ParamAry(1, I) j = j + 1 End If If CDate(ParamAry(1, I)) >= Anker Then ReDim Preserve BtmAry(1, K) BtmAry(0, K) = ParamAry(0, I) BtmAry(1, K) = ParamAry(1, I) K = K + 1 End If Next I Dim n As Long n = 0 If j > 0 Then TopAry = QuickSortB(TopAry) For I = 0 To UBound(TopAry, 2) ReDim Preserve newAry(1, n) newAry(0, n) = TopAry(0, I) newAry(1, n) = TopAry(1, I) n = n + 1 Next I End If ReDim Preserve newAry(1, n) newAry(0, n) = Bnker newAry(1, n) = Anker n = n + 1 If K > 0 Then BtmAry = QuickSortB(BtmAry) For I = 0 To UBound(BtmAry, 2) ReDim Preserve newAry(1, n) newAry(0, n) = BtmAry(0, I) newAry(1, n) = BtmAry(1, I) n = n + 1 Next I End If QuickSortB = newAry End Function |
VBAで配列をソート テーブルを使う
テーブルに入れると言う手もあります
これが一番簡単
SQLserverとつながっているなら一時テーブルに入れ込む
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
Public Function TableSort(Ary As Variant) As Variant 'Dim Ary 'Ary = Array("5", "4", "1", "2", "900", "888") Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = New ADODB.Connection Set rs = New ADODB.Recordset cn.ConnectionString = "接続文字列" cn.Open Dim I As Long I = 0 cn.Execute "drop table if exists #AryT" cn.Execute "select " & CLng(Ary(I)) & "as C into #AryT" For I = 1 To UBound(Ary) cn.Execute "insert into #AryT(C) values(" & CLng(Ary(I)) & ")" Next I rs.Open "select C from #AryT order by C asc", cn, adOpenStatic, adLockOptimistic rs.MoveFirst I = 0 Do Until rs.EOF Ary(I) = rs!C rs.MoveNext I = I + 1 Loop 'For I = 0 To UBound(Ary) ' Debug.Print Ary(I) 'Next TableSort = Ary rs.Close cn.Close End Function |