愚者の経験

「また今度」はほとんどこない

月別アーカイブ: 8月 2011

Access 2010 SP1でファイルが壊れる

既存のプログラムがよく落ちますorz

なにやらVBAの更新があったみたい。↓こことかに情報があります。
http://answers.microsoft.com/ja-jp/office/forum/office_2010-access/access2010-sp1%E9%81%A9%E7%94%A8%E5%BE%8C%E3%81%AB%E7%99%BA%E7%94%9F%E3%81%99%E3%82%8B%E7%8F%BE%E8%B1%A1%E3%81%AB%E3%81%A4%E3%81%84%E3%81%A6/463924d6-fab6-46e3-ba94-2179d1a9239b

もはやデコンパイル必須です。自分は右クリックにデコンパイルのコマンド入れました。
それにしても同じ2010なのにsp1用とsp無し用にプログラムを分けるの推奨とか面倒すぎる。

デコンパイルするにはオプションで「/decompile」を指定しファイルを起動します。
Shiftキーを押していないとそのままAutoExec等がそのまま走りますので注意(^_^;)

自作?クラス1 StringBuffer

VBAの文字列連結を高速にするには「可変長」を使わなければいいらしい。
実際どうするかというと文字列変数にあらかじめ「0」や「vbNullString」等を何文字か入れておき、
文字列の連結時に文字を入れ替える。
あらかじめ入れた文字が足りない場合は連結前に足す。(←ここが可変長の代わり)

参考URL1:http://necro.jp/dev/excel/stringbuffer.html
参考URL2:http://blog.livedoor.jp/midorityo/archives/50744656.html
参考URL3:http://www.tsware.jp/labo/labo_31.htm

上記のURLを参考にさせて頂きました。御礼申し上げますm(_ _)m
クラスモジュールの勉強がてら作ってみました。(といっても殆どURL1の方のコードに…)
自分のノートパソコンでURL3の方の実験(一番最初のコード)をやってみると、

  &連結       Append
11598.67    11608.89
11598.73    11608.91
11598.82    11608.91
11598.96    11608.93

こんな感じでした。早いですね。

文字列処理クラス

Option Compare Database
Option Explicit

Private BufferString As String
Private CharCount As Long
Private BufferSize As Long

Private Sub Class_Initialize()
    Clear
End Sub

Public Sub Append(AddText As String, Optional Repeat As Long = 0)
    Dim AddLength As Long
    AddLength = Len(AddText)
    Do While (CharCount + AddLength > BufferSize)
        BufferString = BufferString & String(BufferSize, 0)
        BufferSize = BufferSize * 2
    Loop
   
    Mid$(BufferString, CharCount + 1, AddLength) = AddText
    CharCount = CharCount + AddLength
    If Repeat – 1 > 0 Then Append AddText, Repeat – 1
End Sub

Public Sub Clear()
    CharCount = 0
    BufferSize = 4096
    BufferString = String(BufferSize, 0)
End Sub

Public Sub Remove(Start As Long, Length As Long)
    CharCount = CharCount – Length
    BufferString = Mid$(BufferString, 1, Start – 1) & Mid$(BufferString, Start + Length)
End Sub

Public Sub Replace(Find As String, Replace As String, Optional Start As Long = -1, Optional Count As Long = 0)
    Dim ReplaceLength As Long
    Dim DiffLength As Long
    ReplaceLength = Len(Replace)
    DiffLength = ReplaceLength – Len(Find)
    Dim Point As Long
    Dim PrePoint As Long
    Dim i As Long
   
    PrePoint = 1
    i = 0
   
    Do
        If InStr(PrePoint, BufferString, Find) = 0 Then Exit Do
       
        Point = InStr(PrePoint, BufferString, Find)
       
        If Point > PrePoint And Point > Start Then
            BufferString = Left$(BufferString, Point – 1) & Replace & Mid$(BufferString, Point + Len(Find))
            CharCount = CharCount + DiffLength
            i = i + 1
           
            If i = Count Then Exit Do
           
            PrePoint = Point + ReplaceLength + 1
        Else
            PrePoint = Point + 1
        End If
       
    Loop
End Sub

Public Sub Insert(InsertText As String, Point As Long)
    If Point >= Me.Length Then
        Me.Append InsertText
        Exit Sub
    End If
   
    Dim AddLength As Long
    AddLength = Len(InsertText)
    Do While (CharCount + AddLength > BufferSize)
        BufferString = BufferString & String(BufferSize, 0)
        BufferSize = BufferSize * 2
    Loop
   
    BufferString = Left$(BufferString, Point – 1) & InsertText & Mid$(BufferString, Point)
    CharCount = CharCount + AddLength
End Sub

Public Function ToString() As String
    ToString = Mid$(BufferString, 1, CharCount)
End Function

Public Property Get Length() As Long
    Length = LenB(StrConv(Mid$(BufferString, 1, CharCount), vbFromUnicode))
End Property

ご自由にお使いいただいて結構ですが自己責任でお願いします。
Replaceの部分がかなり怪しいです。エラー処理等もありません。
改善案、ツッコミ歓迎です。