Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10全般 : Microsoft 365)
同一セル内改行で
投稿日時: 22/08/17 15:15:12
投稿者: jasmineNAO

ご教授下さい。
1つのセルに
  りんご,バナナ,さくらんぼ,もも,レモン,マンゴー,みかん,ぶどう,柿,スイカ,オレンジ,いちじく・・・
とあります。
 
  りんご,バナナ,さくらんぼ,もも,レモン,マンゴー,みかん,ぶどう,
  柿,スイカ,オレンジ,いちじく・・・
 
といったように、
常に「,」が8つ目で同一セル内改行表示するには、どうすれば良いでしょうか?
 
同一セル内改行で調べると、いくつか分かるのですが、
セル内も可変し、常に「,」が8つ目など、少し条件をつけたセル内改行が不明で困っています。
よろしくお願いします。

回答
投稿日時: 22/08/17 15:36:56
投稿者: QooApp

仕組みを作る前に質問があります。
16個目の単語の次のカンマは改行する想定ですか?(倍数の時の処理)
8個目のカンマだけですか?(指定番目のみの処理)

投稿日時: 22/08/17 15:42:13
投稿者: jasmineNAO

 QooAppさん、ありがとうございます。
 
> 16個目の単語の次のカンマは改行する想定ですか?(倍数の時の処理)
 
 はい。8個以内で済むこともありますし、16個目だけでなく、24個以上あるときも・・。
 ですので、8個ぐらいが妥当だと思っているのですが・・・。
 
  りんご,バナナ,さくらんぼ,もも,レモン,マンゴー,みかん,ぶどう,
  柿,スイカ,オレンジ,いちじく・・・,
  ・・・・・・・(2行目続き),
 
 がイメージです。
 
 よろしくお願いします。

回答
投稿日時: 22/08/17 16:16:26
投稿者: QooApp

Sub main()
    '関数名(区切りたい文字列 , 区切り判定の文字 , 追加挿入する文字 , 追加挿入を行う位置番号 , 倍数の時に同様の処理を行う場合はTrue)
    Debug.Print testSplitCell("1,2,3,4,5,6,7,8,9,0,1,2,3", ",", vbCrLf, 8, True)
End Sub

Function testSplitCell(str As String, splitWord As String, splitAddWord, splitCount As Integer, multipleSplit As Boolean) As String
    
    Dim tmp As Variant
    Dim i As Long
    Dim exportStr As String
    exportStr = ""
    
    'まず、区切り文字で文字列を区切る
    tmp = Split(str, splitWord)
    
    '区切り文字で分割した単語単位を再度結合する際に、規定個数まで到達したら挿入する単語を組み込む
    '倍数(multipleSplit = true)の場合は倍数位置でも挿入する
    For i = 0 To UBound(tmp)
        exportStr = exportStr & tmp(i) & splitWord
        
        '倍数判定
        If (multipleSplit) Then
            If ((i + 1) Mod splitCount = 0) Then
                exportStr = exportStr & splitAddWord
            End If
        Else
            If (i + 1 = splitCount) Then
                exportStr = exportStr & splitAddWord
            End If
        End If
    Next
    
    '末尾の削除処理 倍数位置で個数が終了している場合に末尾の削除量が変動する為
    If (Right(exportStr, Len(splitWord & splitAddWord)) = splitWord & splitAddWord) Then
        exportStr = Left(exportStr, Len(exportStr) - Len(splitWord & splitAddWord))
    Else
        exportStr = Left(exportStr, Len(exportStr) - Len(splitWord))
    End If
    
    '戻り値
    testSplitCell = exportStr
    
End Function

 
たまたま手持ちがあったので修正版で参考にどうぞ。
ただしエラーが発生した場合の処理が想定されていないので想定外の挙動をする可能性はあります。

回答
投稿日時: 22/08/17 16:18:47
投稿者: QooApp

testSplitCellって関数名は適当過ぎましたね
 
autoLineFeed()とか適当に関数名割り当て直してください。

回答
投稿日時: 22/08/17 16:21:29
投稿者: QooApp

あ、引数でvbCrLfを挿入していますが、Debug.Printの画面で確認する用なのでCells().Valueに戻す場合はVbLfで設定してください。戻し忘れた…。

投稿日時: 22/08/17 16:52:27
投稿者: jasmineNAO

 QooAppさん
 
 ご教授ありがとうございます!
 やりたかったことができました!
 実は本当に困っていたので、助かりました!