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

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

Windows 10 Technical PreviewにインストールしたOffice XP DeveloperでCOMアドインを作ってみた。前のページ

2015年2月の人気記事次のページ

関連記事

  1. Office関連

    Office 2007のサポートが2017年10月10日に終了します。

    2007年1月にパッケージ版が発売されてから早10年、長らく活躍してき…

  2. Office関連

    PowerPoint 2013ではプレゼンテーションをmp4形式で保存できるようになりました。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  3. Office アドイン

    [Office用アプリ]第一回 Apps for Office 勉強会で登壇しました。

    19日(金)に第一回 Apps for Office 勉強会が東京で開…

  4. Office関連

    ExcelとPowerPointに自動保存機能が追加されました。

    Excel 2016を使っていて、ふと気が付いたのが画面左上にある「自…

  5. Office関連

    Visio Onlineの機能をJavaScriptで拡張する方法

    @mokudaiさんからのバトンを引き継ぎまして、「Office 36…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP