『対応箇所にアルファベットを表示』（Ty）
対応箇所にアルファベットを表示したい。ご教示をお願いします。
A7:P10の入力済の箇所(都度変わる)に対応する、A1:P4に縦にアルファベットのAからAHまでの値を順にマクロで表示したい
|[A]|[B]|[C]|[D]|[E]|[F]|[G]|[H]|[I]|[J]|[K]|[L]|[M]|[N]|[O]|[P]
[1] |A |C |G |I |K | |O | |S |V |X |Z | |AC | |AG
[2] |B |D |H |J |L | |P | |T |W |Y |AA | |AD | |AH
[3] | |E | | |M | |Q | |U | | |AB | |AE | |
[4] | |F | | | | |R | | | | | | |AF | |
[5] | | | | | | | | | | | | | | | |
[6] | | | | | | | | | | | | | | | |
[7] | 5| 2| 3| 6| 3| | 6| | 3| 6| 6| 6| | 4| | 2
[8] | 4| 5| 6| 7| 4| | 2| | 6| 2| 7| 6| | 5| | 6
[9] | | 3| | | 6| | 2| | 5| | | 4| | 2| |
[10]| | 5| | | | | 5| | | | | | | 3| |
＜ 使用 Excel：unknown、使用 OS：unknown ＞
↓こういうこと？
Sub test()
Dim r As Long, c As Long, cnt As Long, buf As Variant
Range("A1:P4").ClearContents
cnt = 0
For c = 1 To 16
For r = 1 To 4
If Range("A1").Offset(r + 5, c - 1) <> "" Then
buf = Split(Range("A1").Offset(0, cnt).Address, "$")
Cells(r, c) = buf(1)
If buf(1) = "AH" Then Exit For
cnt = cnt + 1
End If
Next r
Next c
End Sub
ちなみに、G1セルは「N」なのでは？ （通行人） 2026/05/31(日) 09:43:43
If buf(1) = "AH" Then Exit For ↑は、↓へ修正をお願いします。（処理終了して良いので） If buf(1) = "AH" Then Exit Sub （通行人） 2026/05/31(日) 09:48:46
余り変わらないが、折角書いたのでupしておきます。
Sub test()
Dim rng As Range
Dim k&, c&, r&, p&
Dim ofst&
Set rng = Range("A7:P10") '対象セル範囲
'alphabetの作成（最大個数まで予め作成しておく）
ReDim alpha(1 To rng.Count) As String
For k = 1 To rng.Count
alpha(k) = Replace(Cells(1, k).Address(False, False), "1", "")
Next
'A7:P10を見て、入力済みなら、1行目から始まるセル範囲にAlphabetを順に書き込む
ofst = 1 - rng(1).Row
For c = rng(1).Column To rng(rng.Count).Column
For r = rng(1).Row To rng(rng.Count).Row
If Cells(r, c).Value <> "" Then
p = p + 1
Cells(r, c).Offset(ofst) = alpha(p)
End If
Next
Next
End Sub
# 確かにNが抜けてしまってますね。 （xyz） 2026/05/31(日) 09:56:33
も少し 教えてください。
マクロコード内で
AとかBとかの文字が無いのに
表示ができているんですが、
どこの部分コードでできるんですか？
(XYZ)様
ありがとうございました。
今から見させていただきます。
（Ty） 2026/05/31(日) 10:04:33
できました。
箇所が増えても
AH以降の表示ができました。
書き漏れのNでした。
（Ty） 2026/05/31(日) 10:20:18
■1
＞AとかBとかの文字が無いのに〜どこの部分のコードでできるんですか？
ステップ実行をして確認してみてはいかがでしょうか。
一応解説すると、お二人とも【セル番地】を加工しています。
〜〜通行人さんの考え方〜〜
1. 【セル番地（絶対参照）】をSplit関数で「$」を区切り文字として4つに分解する
（「$A$1」なら、0番目：空文字、1番目：「A」、2番目：空文字、3番目：「1」になる）
2. そのうち1番目の要素を変数に格納する
3. 変数に格納した値をセルに書き込む
〜〜xyzさんの考え方〜〜
1. 【セル番地（相対参照）】から「1」という文字をReplace関数を使って削除（""に置換）する
（「A1」なら、「1」が削除されて「A」になる）
2. その値を配列のk番目に格納する
3. 対象セル範囲を巡回し、空白でないセルに対して、配列のp番目の値を書き込む
■2
ケースにもよりますが、理屈上はセルへの書き込み回数を減らした方が高速になることが多いです。
また、空白でないセルの数だけアルファベットを生成すればよいため、最大数まで作成しなくても問題ないと思います。
ということを踏まえると以下のようなアプローチもあるとおもいます。
興味があれば【ステップ実行】して研究してみてください。
Sub 研究用()
Dim MyArr() As Variant 'アルファベット用
Dim tmp() As Variant '書き込む情報の一時貯留用
Dim c As Long, x As Long, y As Long
Dim MyRNG As Range
Set MyRNG = ActiveSheet.Range("A7:P10")
With ActiveSheet.Range("A7:P10")
ReDim tmp(1 To .Rows.Count, 1 To .Columns.Count)
ReDim MyArr(1 To WorksheetFunction.Count(.Cells))
'▼アルファベット群をブランクでないセルの数だけ生成
For c = 1 To WorksheetFunction.Count(MyRNG)
MyArr(c) = Split(ActiveSheet.Cells(1, c).Address, "$")(1)
Next
'▼セル範囲を縦方向に巡回して、空白でなかったら一時貯留用配列の該当箇所に、c番目のアルファベットを格納
c = 1 'カウンタをリセット
For y = 1 To .Columns.Count
For x = 1 To .Rows.Count
If .Cells(x, y) <> "" Then
tmp(x, y) = MyArr(c)
c = c + 1
End If
Next x
Next y
'▼セルへの書き込みを一度に行うことで高速化
ActiveSheet.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = tmp
End With
End Sub
（もこな２） 2026/06/03(水) 20:42:41
皆様の懇切丁寧な説明にお礼申し上げます。
（Ty） 2026/06/04(木) 21:01:08
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.