FC2ブログ
--年--月--日 (--) | Edit |
上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。
2009年05月20日 (水) | Edit |
http://necro.jp/dev/excel/stringbuffer.html
こちらで文字列操作での高速化をやってますが、アレンジしてみました。
ただし、メモリの使用量は私のほうが格段に高いです。
まぁ、その分といっては何ですが、若干高速化しています。

・・・インデントが無効化されるけどご容赦を・・・;;
Option Explicit

Private strObject As String
Private lngLength As Long
Private lngBufSize As Long

Private Sub Class_Initialize()
Call Init
End Sub

Private Sub Class_Tarminate()
strObject = ""
lngLength = 0
lngBufSize = 0
End Sub

'初期化
Public Sub Init()
lngLength = 0
lngBufSize = 4096
strObject = String$(lngBufSize, 0)
End Sub

'ガーベッヂコレクタ
Public Sub gc()
Dim lngPresentBuf As Long
Dim lngPresentLen As Long
If lngLength > 0 Then
lngPresentBuf = lngBufSize / 4096 + 1
lngPresentLen = lngLength / 4096 + 1
If lngPresentBuf <> lngPresentLen Then
lngBufSize = lngPresentLen * 4096
End If
Else
lngBufSize = 4096
End If
strObject = Left$(strObject, lngBufSize)
End Sub

Public Sub Clear()
lngLength = 0
End Sub

'追記
Public Sub Append(ByRef strAppend As String)
Dim lngAppender As Long
Dim lngDiff As Long

lngAppender = Len(strAppend)
lngDiff = lngAppender + lngLength
If lngDiff > lngBufSize Then
strObject = strObject & String$(lngBufSize, 0)
lngBufSize = lngBufSize * 2
End If
Mid$(strObject, 1 + lngLength, lngAppender) = strAppend
lngLength = lngDiff

End Sub

Public Sub AppendLine(ByRef strAppend As String)
Call Append(strAppend & vbCrLf)
End Sub

'置換
Public Sub Replace(ByRef strSearch As String, ByRef strReplace As String)
Dim lngDiff As Long
Dim lngStr As Long
Dim lngSearch As Long
Dim lngReplace As Long

lngSearch = Len(strSearch)
lngReplace = Len(strReplace)
lngDiff = lngSearch - lngReplace
lngStr = InStr(1, strObject, strSearch)
If lngStr = 0 Then
ElseIf lngDiff = 0 Then
While lngStr <> 0
Mid$(strObject, lngStr, lngSearch) = strReplace
lngStr = InStr(lngStr, strObject, strSearch)
Wend
Else
While lngStr <> 0
Change (Left$(strObject, lngStr) & strReplace & Mid$(strObject, lngStr + lngSearch))
lngStr = InStr(lngStr, strObject, strSearch)
Wend
End If

End Sub

'書き換え
Public Sub Change(ByRef strChange As String)
Call Clear
Call Append(strChange)
End Sub

Public Function toString() As String
toString = Mid$(strObject, 1, lngLength)
End Function

'プロパティ
Public Property Get Length() As Long
CharCount = lngLength
End Property

Public Property Get LengthBytes() As Long
Length = LenB(StrConv(Mid$(strObject, 1, lngLength), vbFromUnicode))
End Property

Public Property Get BufferSize() As Long
BufferSize = lngBufSize
End Property
スポンサーサイト
コメント
この記事へのコメント
コメントを投稿
URL:
Comment:
Pass:
秘密: 管理者にだけ表示を許可
 
トラックバック
この記事のトラックバックURL
この記事へのトラックバック

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。