Office関連

[VBA]桁を揃えてDebug.Printする。

@CallMeKoheiさんのブログの記事に「Excel VBA イミディエイトウインドウで整列!」という記事がありました。

たしかに、イミディエイト ウィンドウで桁を揃えてDebug.Printできたら見やすくて便利かもしれません。

というわけで、早速簡単な処理を考えてみました。

Option Explicit

Public Sub Sample()
  Dim v As Variant
 
  v = Array("abcde", _
            "あいう", _
            "123", _
            "東京都葛飾区", _
            "a")
  DebugPrintPadRight v
  v = Array("北海道網走市稲富", _
            "", _
            "abcdefghijkl", _
            "あいうえおかきくけこ", _
            "0123456789")
  DebugPrintPadRight v
End Sub

Public Sub DebugPrintPadRight(ByVal ary As Variant, _
                              Optional ByVal max_size As Long = 30)
  Dim tmp As String, ret As String
  Dim n As Long, i As Long
 
  For i = LBound(ary) To UBound(ary)
    n = LenB(StrConv(ary(i), vbFromUnicode))
    If max_size < n Then n = max_size
    tmp = StrConv(LeftB(StrConv(ary(i) & Space(max_size - n), vbFromUnicode), max_size), vbUnicode)
    If i = LBound(ary) Then
      ret = tmp
    Else
      ret = ret & vbTab & tmp
    End If
  Next
  Debug.Print ret
End Sub

上記Sampleを実行すると、下図のように文字列の頭が揃った状態でDebug.Printされます。

DebugPrintPad_01

やっていることは単純で、文字列のお尻に空白をくっ付けて、指定したバイト数で頭から切り出すという、よくあるパディング(埋め)処理です。

ただ、日本語を扱う場合だと、半角文字と全角文字が混在になってしまう可能性があるので、「文字列の長さを取得する(Len/LenB関数):Excel VBA|即効テクニック」にあるような方法で文字列の長さを調整しています。

文字列を一つ一つ指定すると処理が面倒になってしまうため、引数として渡すのは配列にしています。

複数の配列を渡して、まとめてDebug.Printしたい場合は、下記のようにCollectionに入れてループを回せば良いかと思います。

Public Sub Sample2()
  Dim colAry As VBA.Collection
  Dim i As Long
  
  Dim ary1 As Variant
  Dim ary2 As Variant
  Dim ary3 As Variant
  Dim ary4 As Variant
  Dim ary5 As Variant
  Dim ary6 As Variant
  
  ary1 = Array("あいう", "abc", "北海道", "123456789")
  ary2 = Array("かきくけこ", "abcdefghjiklmn", "")
  ary3 = Array("", "abcdefghj", "東京都新宿区", "012")
  ary4 = Array("あいうえおかきくけこさしすせそ", "ab", "123456789")
  ary5 = Array("たちつてとなにぬねのはひふへほまみむめも")
  ary6 = Array("あかさたなはまやらわ", "aiueokakikukekosashishuseso", "沖縄県那覇市", "012345678901234567890123456789")
  
  Set colAry = New VBA.Collection
  colAry.Add ary1
  colAry.Add ary2
  colAry.Add ary3
  colAry.Add ary4
  colAry.Add ary5
  colAry.Add ary6
  
  For i = 1 To colAry.Count
    DebugPrintPadRight colAry(i), 10
  Next
End Sub

DebugPrintPad_02

シンプルな処理ですので、実際に上記コードを使う際には、自分の好みに合わせて適当に変更してお使いください。

また、Web検索したところ、海外のサイトで下記のようなWebページも見つけました。

・VBA Tips & Tricks: Aligning Text Output in Variables
http://vbadud.blogspot.jp/2007/04/aligning-text-output-in-variables.html

LSetRSetを使う方法、これもとても面白い方法ですね!

2015/02/25 追記:
お尻を空白で埋めて頭から切り出す処理を書いておいて、逆に頭を空白で埋めてお尻から切り出す処理がないのは尻切れトンボだったので、処理を追加しました。

Public Sub Sample3()
  Dim colAry As VBA.Collection
  Dim i As Long
  
  Dim ary1 As Variant
  Dim ary2 As Variant
  Dim ary3 As Variant
  Dim ary4 As Variant
  Dim ary5 As Variant
  Dim ary6 As Variant
  
  ary1 = Array("あいう", "abc", "北海道", "123456789")
  ary2 = Array("かきくけこ", "abcdefghjiklmn", "")
  ary3 = Array("", "abcdefghj", "東京都新宿区", "012")
  ary4 = Array("あいうえおかきくけこさしすせそ", "ab", "123456789")
  ary5 = Array("たちつてとなにぬねのはひふへほまみむめも")
  ary6 = Array("あかさたなはまやらわ", "aiueokakikukekosashishuseso", "沖縄県那覇市", "012345678901234567890123456789")
  
  Set colAry = New VBA.Collection
  colAry.Add ary1
  colAry.Add ary2
  colAry.Add ary3
  colAry.Add ary4
  colAry.Add ary5
  colAry.Add ary6
  
  For i = 1 To colAry.Count
    DebugPrintPadLeft colAry(i), 20
  Next
End Sub

Public Sub DebugPrintPadLeft(ByVal ary As Variant, _
                             Optional ByVal max_size As Long = 30)
  Dim tmp As String, ret As String
  Dim n As Long, i As Long
 
  For i = LBound(ary) To UBound(ary)
    n = LenB(StrConv(ary(i), vbFromUnicode))
    If max_size < n Then n = max_size
    tmp = StrConv(RightB(Space(max_size - n) & StrConv(ary(i), vbFromUnicode), max_size), vbUnicode)
    If i = LBound(ary) Then
      ret = tmp
    Else
      ret = ret & vbTab & tmp
    End If
  Next
  Debug.Print ret
End Sub

DebugPrintPad_03

引数を追加して、右埋め左埋めを切り替えるようにしても良いかもしれません。

関連記事

  1. Office関連

    関数一覧(Excel 2013)

    関数の挿入ダイアログから抽出したExcel 2013の関数情報を表にし…

  2. Office関連

    関数一覧(Excel 2013 Customer Preview)

    関数の挿入ダイアログから抽出したExcel 2013 Customer…

  3. Office関連

    オフライン版のOffice 2016 VBAリファレンスが公開されました。

    「ヘルプファイル版のOffice 2013開発者用リファレンスが公開さ…

コメント

  1. この記事へのコメントはありません。

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP