[[20220223092655]] 『コードを整理して短くしたい』（KonNo） ページの最後に飛ぶ
[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コードを整理して短くしたい』（KonNo）
現在、以下のコードを利用している。
24行目以下が同じFor分の連続処理（4回）なのでコードを整理して短くしたいのですが
良きアドバイスをお願いします。
Option Explicit
Sub セルに入力された文字列を一文字ずつ横方向に分解する()
Dim str As String Dim i As Long, ii As Long
'書き出しセルの初期化
For i = 2 To 8 Step 2
For ii = 2 To 41
Cells(i, ii).Clear
Next
Next
'指定文字の分割
With Range("A10")
str = .Value
For i = 1 To 40
.Offset(-8, i).Value = Mid(str, i, 1)
Next i
For i = 41 To 80
.Offset(-6, i - 40).Value = Mid(str, i, 1)
Next
For i = 81 To 120
.Offset(-4, i - 80).Value = Mid(str, i, 1)
Next
For i = 121 To 160
.Offset(-2, i - 120).Value = Mid(str, i, 1)
Next
End With
End Sub
参考画像
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
画像の埋め込みに全神経を集中されているようで、
24行目以降がどうなっているのか説明がありませんから、
具体的な回答のしようがありません。
Range("A10")に対する処理をFunctionにしておいて、
24行目以降に対しても、それを使った繰り返し処理にすればよいのでは？
（γ） 2022/02/23(水) 09:43
VBAの問題ではなく、算数の問題でしょう
For i = 1 To 160
Debug.Print i, ((i - 1) \ 40) * 2 - 8, (i - 1) Mod 40 + 1
Next
（とおりすがり） 2022/02/23(水) 09:51
そういえばセルを原稿用紙に見立ててという記事がこのサイトにもありましたね。
（・・・） 2022/02/23(水) 10:04
参考に
Sub Test()
Dim i As Long
Dim rng As Range, c As Range
Set rng = Union(Cells(2, 2).Resize(, 40), Cells(4, 2).Resize(, 40), Cells(6, 2).Resize(, 40), Cells(8, 2).Resize(, 40))
rng.Clear
For Each c In rng
i = i + 1
c.Value = Range("A10").Characters(i, 1).Text
Next
End Sub
（ピンク） 2022/02/23(水) 10:20
皆さんのアドバイス感謝します。
数学的な問題と言われればその通りですが
中々求めるのに試行錯誤が続いています。
私の方でアドバイスを検討する時間が必要です。
＞24行目以降がどうなっているのか説明がありませんから、
安易に、テキストエディターで質問文を作成した時に
テキストエディターが左側に自動で書き出す通し番号をそのまま書いちゃいました。
具体的なFor分の連続処理（4回）とは以下の事です。
For i = 1 To 40
.Offset(-8, i).Value = Mid(str, i, 1)
Next i
For i = 41 To 80
.Offset(-6, i - 40).Value = Mid(str, i, 1)
Next
For i = 81 To 120
.Offset(-4, i - 80).Value = Mid(str, i, 1)
Next
For i = 121 To 160
.Offset(-2, i - 120).Value = Mid(str, i, 1)
Next
（KonNo） 2022/02/23(水) 10:39
ピンクさんのUNIONを使ったコードはとても参考になります。
UNIONで４つに分割された領域を1つの領域のように
扱えるようになるので数学的なアプローチがなくても
順番に文字列を書き出して行くだけなのでスッキリしました。
感謝、感謝です。
（KonNo） 2022/02/23(水) 12:19
>UNIONを使ったコードはとても参考になります。 UNIONを使わなくても
Sub Test()
Dim i As Long
Dim c As Range
With Range("B2:AO2,B4:AO4,B6:AO6,B8:AO8")
.ClearContents
For Each c In .Cells
i = i + 1
c.Value = Range("A10").Characters(i, 1).Text
Next
End With
End Sub
（ピンク） 2022/02/23(水) 12:43
自身で解釈に時間を要すようであれば、
今のままがご自身で分かりやすいのだから、無理して修正することもないと思いますよ。
せいぜい数行減るだけでしょう？
その原稿用紙状のものは10行目までしかないのですか？
そうであれば、なんとでもなりそうなわけで、例えば、
こんな書き方もあるでしょう。
Sub test2()
With Range("B2:AO2,B4:AO4,B6:AO6,B8:AO8")
.Formula = "=MID($A$10,B1,1)"
' .Value = .Value
End With
End Sub
むしろ、11行目以下にも同様なものがあるんじゃないんですか？
それをどうするかを考えたほうがいいんじゃないですか？
24行目というのが、コードのどこを指しているのか全く不明だが、
そういう訳が分からないことは書かないでいただきたい。
# 単に画像をリンクした質問をしたかっただけでは？ww
（γ） 2022/02/23(水) 13:55
ピンクさん、UNIONを使わなくても処理できるコードありがとうございます。
γさん、誤解がありそうなので以下説明をしますね。
＞24行目というのが、コードのどこを指しているのか全く不明
10:39の私の説明でご理解願えないのであれば
どう説明していいか私には分かりません。
＞# 単に画像をリンクした質問をしたかっただけでは？
質問を理解する上で理解が深まるので良かれと思って添付した画像を
そのように受け取られるとは。。。。。
＞今のままがご自身で分かりやすいのだから、無理して修正することもないと思いますよ。
他のVBAの達人の方のコードを見ることで以後の自分の成長に繋がると思っています。
（取り敢えず何とか成っている応用が効かないコードに以後の成長は無いと思っています。）
＞むしろ、11行目以下にも同様なものがあるんじゃないんですか？
いいえ、他には有りません。
あるファーマット変換ソフトで出力されるファイル名が、とても長くなるので
不必要な部分を求めるのに先頭から数えていては間違いが多く現実的では有りません。
（例えば、20-30番目までは不要とか）
現実的には１６０文字も考慮する必要は無いかも知れませんが大は小を兼ねる的な考えで
あえて対象文字列を多めに取っています。
今回のマクロで位置が特定できれば、後はファイル名変換ソフトでリネームが出来ます。
＞Sub test2()
上手く処理できるのを確認しました。
.Formula = "=MID($A$10,B1,1)"の記載は、なぜ上手く処理できる
言葉は悪いのですが「からくり」が分かりません。
（KonNo） 2022/02/23(水) 16:15
私なら、こう書くかも知れません。
Sub 一文字ずつ横方向に分解()
Dim str As String
Dim i As Long, ii As Long
Dim idx As Long
'書き出しセルの初期化
For i = 2 To 8 Step 2
Cells(i, 2).Resize(, 40).Clear
Next
'指定文字の分割
str = Range("A10").Value
idx = 0
For i = 2 To 8 Step 2
For ii = 2 To 41
idx = idx + 1
Cells(i, ii).Value = Mid(str, idx, 1)
Next ii
Next i
End Sub
（半平太） 2022/02/23(水) 19:12
半平太さん、ありがとうございます。
私に取って馴染みのある基本的なコードによる回答なので判りやすいです。
このようなコードが直ぐに書けるようなスキルアップを目指します。
（KonNo） 2022/02/24(木) 08:08
コメント返信：
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.