2019年8月8日 / 最終更新日時 : 2021年12月30日 officeの杜 msoffice

選択行のデータをTSVテキストに変換するExcelアドイン

脱Excelができない理由の一つとして、情シスやパッケージで導入したシステムの力量不足が挙げられます。前者の場合は開発者自身の力量不足と責任回避の為、後者の場合は主に予算の都合でカットされる。その為、実際の現場の業務との差を埋めてくれるのは、他でもないExcelであり、時には基幹業務システムの1部を担うことも珍しくありません。

そんなケースに於いて、Excelのデータを基幹業務システムでインポートできる形式に変換してといった作業があります。1個2個程度ならVBAなど書かなくても良いですが、利用者が多数で利用頻度も高いとなるとプログラムを作る必要があります。今回もSAP HANA上にローカルデータを取り込む為のものを作る事になりました。(API叩いて流しこめばいいじゃんって思ったそこのあなた。それ金融系のコンサル会社の担当にも言ってあげて下さい）

今回はSAP向けにTSV形式でExcelのデータを変換して出力するアドインを作ってみました。

1 今回利用するファイル等
2 事前準備
3 使い方
4 ソースコード
5 関連リンク

今回利用するファイル等

アドイン形式であるxlamで作成しているので、導入が必要になります。また、出力されるtextファイルはTSV形式で、文字コードはShift-JIS形式としています（VBA内のオプションを変更すれば、UTF-8での出力も確認済みです）。

事前準備

今回のファイルはアドイン形式であるため、利用する為にはいくつかの準備が必要になります。アドインですので、単体では動作しません。手順に従って導入する事で、全てのExcelファイルで利用する事ができるようになります。

開発タブを表示する

アドインの導入には開発タブの表示が必要ですが、デフォルトの状態では「表示されていない」人が殆どです。以下の手順で開発タブを表示するようにしましょう。

メニューより「ファイル」⇒「オプション」を開きます。
左側サイドバーより「リボンのユーザ設定」をクリックします。
右側のリボンのユーザ設定内に「開発」があり、チェックが外れていると思うので、チェックを入れてあげます。
OKボタンを押して完了

図：開発タブを表示しないと導入できない

アドインを導入する

添付のtabusaku.xlamファイルをデスクトップにでも保存してください。その後、以下の手順でアドインを導入してください。

アドインは自分のマイドキュメントの「ドキュメントフォルダ」にでも入れておきましょう（デスクトップだと失くす可能性があるため）
Excelの「開発タブ」を開きます。
「Excelアドイン」をクリックします。
アドインダイアログが出たら、「参照」をクリックします。
ファイルの参照ダイアログが出てきます。右下の「アドイン(*.xlam, *.xla, *.xll)」の部分は、「すべてのファイル(*.*)」に変更します。
1.で保存したtabusaku.xlamを見つけてOKボタンを押します。
これで追加完了。OKボタンを押して終了です
リボンの所に「タブ作君」というタブが出てくるようになり、「TSVへ変換出力」のボタンが追加されているはずです。

図：アドイン追加ダイアログ

参照設定の追加

アドインとして作る場合、以下のモジュールを参照設定に追加しておく必要があります。アドインを使うだけの人は特に何も作業は必要ありません。この設定はこのアドインを作成するプログラマの作業になります。

Microsoft ActiveX Data Object 6.1 Library - テキストデータの書き出し時に利用する
Microsoft Office 16.0 Object Library - リボンで利用する
Microsoft Scripting Runtime - 連想配列のDictionaryやファイルの有無、特殊フォルダの取得などで利用する

図：参照設定が必要になります

使い方

このアドインは以下のような機能を持っています。

添付してある見本のExcelファイルのような形式の時に、選んだ行（Ctrlキーで飛ばして行選択も対応）だけをTAB区切りテキストとして出力します。
出力先はデフォルトではシート名（デスクトップを指定）がファイル名になりますが、変更する事が可能です。
タイトル行（項目名のある行）を含めた場合には、その行も出力されます。ヘッダーありの場合にはタイトル行も選択行に含めてください。
出力したデータは、Shift-JIS形式のTAB区切りテキストです（CSVではありません）
復数行を選んだら、「タブ作君」というタブ内にある「TSVへ変換出力」をクリック、保存先を聞いてくるので、選んでOKで出力完了です。
普通のテキストファイルなのでメモ帳などで中身を確認する事が可能です。

図：行選択してこのボタンを押す

ソースコード

リボンのXMLコード

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" xmlns:mso="http://schemas.microsoft.com/office/2009/07/customui" 
onLoad="OnLoad">
  <ribbon>
    <tabs>
      <tab id="SampleTab" label="タブ作君" getVisible="Tab_getVisible">
        <group id="toolgroup" label="変換ツール" centerVertically="true">
     		<button id="customButton" label="TSVへ&#xD;変換出力" image="niku" size="large" onAction="changeman" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" xmlns:mso="http://schemas.microsoft.com/office/2009/07/customui"

onLoad="OnLoad">

<tabs>

</group>

</tab>

</tabs>

</ribbon>

</customUI>

nikuというイメージファイルを埋め込んであります。
ボタンクリック時には、changemanというコードが実行される仕組みです。
ファイル読み込み時には、OnLoadというコードが実行され、リボンの初期化が実行されます。
今回のコードは、Custom Ribbon UI Editorを使って作成しています。

リボン初期化のコード

Public m_ribbon As IRibbonUI

'リボン起動時に初期化するコード
Public Sub OnLoad(ribbon As IRibbonUI)
    'リボンのインスタンスを取得
    Set m_ribbon = ribbon
    '自作のリボンをアクティブにする
    m_ribbon.ActivateTab ("SampleTab")
End Sub

'タブの表示状態を取得する
Public Sub Tab_getVisible(control As IRibbonControl, ByRef returnedVal)
    '常にタブを表示する
    returnedVal = True
End Sub

'リボン用直接実行関数
Public Sub changeman(control As IRibbonControl)
    Call tsvconverter
End Sub

Public m_ribbon As IRibbonUI

'リボン起動時に初期化するコード

Public Sub OnLoad(ribbon As IRibbonUI)

'リボンのインスタンスを取得

Set m_ribbon = ribbon

'自作のリボンをアクティブにする

m_ribbon.ActivateTab ("SampleTab")

End Sub

'タブの表示状態を取得する

Public Sub Tab_getVisible(control As IRibbonControl, ByRef returnedVal)

'常にタブを表示する

returnedVal = True

End Sub

'リボン用直接実行関数

Public Sub changeman(control As IRibbonControl)

Call tsvconverter

End Sub

リボンを初期化するOnLoadのコマンド及び変換実行のchangemanのコードです

メインのVBAコード

'現在アクティブで選択されている行だけをUTF8のTSVファイルとして出力するコード
Public Function tsvconverter()
    '現在アクティブになってるシート名を取得する
    Dim activesheetman As String
    activesheetman = ActiveSheet.Name

    '// シートの入力範囲の全セルを取得
    Dim rUsed As Range
    Set rUsed = ActiveSheet.UsedRange
    
    '行選択されているかどうかチェック
    Dim lineman As Boolean
    lineman = line_check()
    
    If lineman = False Then
        '行選択されていないので終了
        MsgBox "行選択されていませんよ"
        Exit Function
    End If

    'ユーザのデスクトップパスを取得する
    Dim Path As String, WSH As Variant
    Set WSH = CreateObject("WScript.Shell")
    Path = WSH.SpecialFolders("Desktop")
    Set WSH = Nothing
    
    'ファイルの出力先を指定
    Dim savepath As Variant
    savepath = Application.GetSaveAsFilename(InitialFileName:=Path & "" & activesheetman & ".txt", FileFilter:="TAB区切りテキスト,*.txt")

    'フォルダ選択がキャンセルされた場合
    If savepath = False Then
        MsgBox "保存場所の指定がキャンセルされました。"
        Exit Function
    End If

    'テキスト出力用の変数
    Dim ts As TextStream
    Dim fs As New FileSystemObject
    Dim s
    Dim iRow
    iRow = 0

    '現在選択されている行を取得する
    Dim rng As Range
    Dim r As Range
    Dim cnt As Integer
    cnt = 1
    
    '選択行カウント用の配列を用意
    Dim Member As Dictionary
    Set Member = New Dictionary

    '選択行の行番号連想配列に追加する
    Dim test As Variant
    For Each rng In Selection.Rows
        '行番号を入れる
        test = rng.Row
        Member.Add cnt, test
        
        'カウンタを追加する
        cnt = cnt + 1
    Next rng

    '1セルずつループ
    Dim firstflg As Boolean
    firstflg = True
    Dim varResult As Variant
    Dim execflg As Boolean
    execflg = False
    
    '連想配列処理用変数
    Dim dicman As Integer
    Dim tempdic As Variant
    dicman = Member.Count
    
    For Each r In rUsed
        '現在の行番号が配列にいるかどうかチェック
        For i = 0 To dicman
            '要素を取り出す
            tempdic = Member.Item(i)
            
            '行番号とdictionaryの値が一致してたらフラグを立てる
            If tempdic = r.Row Then
                execflg = True
                Exit For
            End If
        Next i
        
        '戻り値配列のサイズで要素の有無を判定
        If execflg = True Then
            '指定行なのでデータの処理を行なう
            If iRow <> r.Row Then
                '// ループ初回時ではない場合
                If firstflg = False Or r.Column <> rUsed.Column Then
                    '// 行が変わったため改行コードを付与
                    s = s & vbCrLf
                Else
                    firstflg = False
                End If
                
                '// 行の先頭値を連結
                s = s & r.Text
            Else
                '// タブ文字区切りで連結
                s = s & vbTab & r.Text
            End If
            
        Else
            '配列にいない行なのでスルーする
        End If
        
        '現在行番号を取得
        iRow = r.Row
        
        'フラグを初期化
        execflg = False
        
    Next

    'ADODB.streamによるUTF-8形式での出力
    Dim output As ADODB.Stream
    Set output = New ADODB.Stream

    'セルの文字列が存在する場合TXTを書き込みする
    If s <> "" Then
        'Shift-JISで出力する(UTF-8を指定するとUnicodeになる）
        With output
            'Shift-JISで設定して開く
            .Type = adTypeText
            .Charset = "Shift-JIS"
            .LineSeparator = adLF
            .Open
        End With
        
        'ファイルの書き出し
        With output
            '出力内容を書き出し
            .WriteText s, adWriteLine
            
            'ファイルを保存する
            .SaveToFile savepath, adSaveCreateOverWrite
            
            '閉じる
            .Close
        End With
    End If
    
    '終了処理
    'Call ts.Close
    MsgBox "データをテキスト形式に変換しましたよ！"
End Function

'行選択されているかどうかチェック
Public Function line_check() As Boolean
    '変数の宣言
    Dim lineadd As String
    lineadd = Selection.Address(False, False)
    lineadd = Replace(lineadd, ":", "")
    
    '選択行かどうかを確認
    If IsNumeric(lineadd) Then
        line_check = True
    Else
        line_check = False
    End If
End Function

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

'現在アクティブで選択されている行だけをUTF8のTSVファイルとして出力するコード

Public Function tsvconverter()

'現在アクティブになってるシート名を取得する

Dim activesheetman As String

activesheetman = ActiveSheet.Name

'// シートの入力範囲の全セルを取得

Dim rUsed As Range

Set rUsed = ActiveSheet.UsedRange

'行選択されているかどうかチェック

Dim lineman As Boolean

lineman = line_check()

If lineman = False Then

'行選択されていないので終了

MsgBox "行選択されていませんよ"

Exit Function

End If

'ユーザのデスクトップパスを取得する

Dim Path As String, WSH As Variant

Set WSH = CreateObject("WScript.Shell")

Path = WSH.SpecialFolders("Desktop")

Set WSH = Nothing

'ファイルの出力先を指定

Dim savepath As Variant

savepath = Application.GetSaveAsFilename(InitialFileName:=Path & "" & activesheetman & ".txt", FileFilter:="TAB区切りテキスト,*.txt")

'フォルダ選択がキャンセルされた場合

If savepath = False Then

MsgBox "保存場所の指定がキャンセルされました。"

Exit Function

End If

'テキスト出力用の変数

Dim ts As TextStream

Dim fs As New FileSystemObject

Dim s

Dim iRow

iRow = 0

'現在選択されている行を取得する

Dim rng As Range

Dim r As Range

Dim cnt As Integer

cnt = 1

'選択行カウント用の配列を用意

Dim Member As Dictionary

Set Member = New Dictionary

'選択行の行番号連想配列に追加する

Dim test As Variant

For Each rng In Selection.Rows

'行番号を入れる

test = rng.Row

Member.Add cnt, test

'カウンタを追加する

cnt = cnt + 1

Next rng

'1セルずつループ

Dim firstflg As Boolean

firstflg = True

Dim varResult As Variant

Dim execflg As Boolean

execflg = False

'連想配列処理用変数

Dim dicman As Integer

Dim tempdic As Variant

dicman = Member.Count

For Each r In rUsed

'現在の行番号が配列にいるかどうかチェック

For i = 0 To dicman

'要素を取り出す

tempdic = Member.Item(i)

'行番号とdictionaryの値が一致してたらフラグを立てる

If tempdic = r.Row Then

execflg = True

Exit For

End If

Next i

'戻り値配列のサイズで要素の有無を判定

If execflg = True Then

'指定行なのでデータの処理を行なう

If iRow <> r.Row Then

'// ループ初回時ではない場合

If firstflg = False Or r.Column <> rUsed.Column Then

'// 行が変わったため改行コードを付与

s = s & vbCrLf

Else

firstflg = False

End If

'// 行の先頭値を連結

s = s & r.Text

Else

'// タブ文字区切りで連結

s = s & vbTab & r.Text

End If

Else

'配列にいない行なのでスルーする

End If

'現在行番号を取得

iRow = r.Row

'フラグを初期化

execflg = False

'ADODB.streamによるUTF-8形式での出力

Dim output As ADODB.Stream

Set output = New ADODB.Stream

'セルの文字列が存在する場合TXTを書き込みする

If s <> "" Then

'Shift-JISで出力する(UTF-8を指定するとUnicodeになる）

With output

'Shift-JISで設定して開く

.Type = adTypeText

.Charset = "Shift-JIS"

.LineSeparator = adLF

.Open

End With

'ファイルの書き出し

With output

'出力内容を書き出し

.WriteText s, adWriteLine

'ファイルを保存する

.SaveToFile savepath, adSaveCreateOverWrite

'閉じる

.Close

End With

End If

'終了処理

'Call ts.Close

MsgBox "データをテキスト形式に変換しましたよ！"

End Function

'行選択されているかどうかチェック

Public Function line_check() As Boolean

'変数の宣言

Dim lineadd As String

lineadd = Selection.Address(False, False)

lineadd = Replace(lineadd, ":", "")

'選択行かどうかを確認

If IsNumeric(lineadd) Then

line_check = True

Else

line_check = False

End If

End Function

選択行のデータをTSVテキストに変換するExcelアドイン

今回利用するファイル等

事前準備

開発タブを表示する

アドインを導入する

参照設定の追加

使い方

ソースコード

リボンのXMLコード

リボン初期化のコード

メインのVBAコード

関連リンク

コメントを残すコメントをキャンセル

AccessでExcelを操作する

Accessのクエリ：3種類の結合の違いについて

今回利用するファイル等

事前準備

開発タブを表示する

アドインを導入する

参照設定の追加

使い方

ソースコード

リボンのXMLコード

リボン初期化のコード

メインのVBAコード

関連リンク

コメントを残す コメントをキャンセル

コメントを残すコメントをキャンセル