AccessVBAのきっかけ～ExcelのBOOK間転記はテキスト挟むとたまに楽～

f:id:nazuna_0124:20170312082946p:plain

VBA書かなくなって随分立つけれどまだ覚えてるかなぁ。

やり始めたきっかけを思い出すのはなかなか楽しいです。

akashi-keirin.hatenablog.com

そんなところでお見かけしたこちらの記事。

あるExcelから他のブックに移動したいことはよくあります。

んで

よーく考えると大抵の場合でデータベース化したいってことがほとんどなんですよね。

Excelだといちいちbook開くの面倒。別に書き込み先は外でもいいじゃん。

ということで、Access＞今のmysqlと流れていくわけです。

やりたいことを考えるとテキストを間に挟めるとむしろ楽なことがあるというお話。

しっかり真似をさせて頂いて。入力画面をこんなかんじ

Excelのバージョンは気にしちゃだめです f:id:nazuna_0124:20170312122941p:plain

つづいてソース

Sub writeTxt()
    Dim FSO As New Scripting.FileSystemObject
    Dim col As New Collection
    Dim PATH As String
    Dim SH As Worksheet
    
    PATH = ThisWorkbook.PATH & "\db.txt"
    Set SH = ThisWorkbook.Worksheets("Sheet1")
    
    col.Add "C3"
    col.Add "C5"
    col.Add "C7"
    col.Add "F3"
    col.Add "F5"
    col.Add "F7"
    
    Dim str As String
    
    
    For i = 1 To col.Count
        
        str = str & SH.Range(col(i)).Value & ","
        
    Next
    
    str = Left(str, Len(str) - 1) & vbCrLf
    
    FSO.OpenTextFile(PATH, ForAppending, True).Write (str)
End Sub

カンマ区切りの文字列にしちゃってテキストファイルに追加書き込みしちゃうのです。

※注意該当テキストファイルを「メモ帳」で開きっぱなしのときは問題ないですが、エディタとかだとロックかかります

作ったコードをF5キーで連打すると

f:id:nazuna_0124:20170312123538p:plain

ウィンドウズのバージョンは気にしちゃだめですってば。

あとは適当に読み取りたい側のBookにテキストファイル読み取るものを作成。

Sub readTxt()
    Dim FSO As New Scripting.FileSystemObject
    Dim col As New Collection
    Dim PATH As String
    Dim SH As Worksheet
    
    
    PATH = ThisWorkbook.PATH & "\db.txt"
    Set SH = ThisWorkbook.Worksheets("Sheet2")
    
    
    Dim str As String
    
    str = FSO.OpenTextFile(PATH, ForReading).ReadAll
    
    
    Dim i As Long
    Dim k As Long
 

    Dim splRow
    Dim tageRow As Long
    
    
    tageRow = 2
    
    splRow = Split(str, vbCrLf)
    
    
    For i = 0 To UBound(splRow) - 1
        For k = 0 To UBound(Split(splRow(i), ","))
            SH.Cells(tageRow, k + 1).Value = Split(splRow(i), ",")(k)
        
        Next k
        tageRow = tageRow + 1
    Next
End Sub[f:id:nazuna_0124:20170312124329p:plain]