Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


32867 / 76734 ←次へ | 前へ→

【49098】Re:Justifyについて
回答  りん E-MAIL  - 07/5/23(水) 3:03 -

引用なし
パスワード
   岳 さん、こんばんわ。

>最初の質問の時に述べたように「justify」を使用すれば文末位置が
>わりと綺麗にそろうので「こりゃいいや」と思ったんで試してみたんですが・・・。
>
文字列が255文字でちぎれるようなので、それより長い文字列は繰り返してJustifyを適用するようにしてみました。

Sub test()
  Dim s1 As String, Rmax&, Rpos&, Md&
  '
  With Application.ActiveSheet
   .Cells(1, "A").Value = ReptStr(1256) '適当な文字列を生成する関数
   '
   s1 = .Cells(1, "A").Value
   '
   '念のため作業エリアをクリア
   Rmax& = .Cells(65536, "A").End(xlUp).Row
   If Rmax& >= 2 Then _
     .Range(.Cells(2, "A"), .Cells(Rmax&, "A")).ClearContents
   '
   'アラート非表示
   Application.DisplayAlerts = False
   'Justify適用初期行
   Rpos& = 1
   Do
     .Cells(Rpos&, "A").Justify
     If Len(s1) <= 255 Then Exit Do
     '繰り返す
     Rmax& = Range("A65536").End(xlUp).Row '上に移動し一番下を判定
     Md& = 255 - Len(.Cells(Rmax&, "A").Value) '途中でちぎれていると仮定
     s1 = Right$(s1, Len(s1) - Md&) '新しい文字列(正しく分割された部分を削除後)
     '新しい位置
     Rpos& = Rmax&
     .Cells(Rpos&, "A").Value = s1 '新しい文字列
   Loop
   '終了
   Application.DisplayAlerts = True
  End With
End Sub
'テスト用の適当な文字列(アルファベットのられつ)
Function ReptStr(arg1 As Long)
  Dim II As Long, s1 As String
  For II = 1 To arg1
   s1 = s1 + Chr(Asc("A") + ((II - 1) Mod 26))
  Next
  ReptStr = StrConv(s1, vbWide)
End Function

無理やり感はありますが、とりあえず結果を出すならこんな感じです。

7 hits

【49041】Justifyについて 07/5/21(月) 16:37 質問
【49044】Re:Justifyについて neptune 07/5/21(月) 17:38 発言
【49047】Re:Justifyについて 07/5/21(月) 18:11 回答
【49053】Re:Justifyについて neptune 07/5/21(月) 22:58 発言
【49055】Re:Justifyについて 07/5/21(月) 23:19 お礼
【49098】Re:Justifyについて りん 07/5/23(水) 3:03 回答
【49119】Re:Justifyについて 07/5/24(木) 8:59 お礼
【49128】Re:Justifyについて 07/5/24(木) 12:09 お礼

32867 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free