条件に一致した場合、参照するセルについて

前提・実現したいこと

　M列にL列の値を入力する
但し、N列が"確認"となっている行はS列の値を上から順番に入力させる

【マクロ実行前】

【マクロ実行後】

発生している問題・エラーメッセージ

・N列の値がある最後の行までしかM列に値が入力されない

　L列もしくはN列の値がある最終行までM列の値が入力されるべきなのに
途中までしか反映しないです

【現在のコード実行後】

該当のソースコード

Sub てすと()

Dim dt(), ctr As Long, c As Range

Range("M6:M" & Rows.Count).ClearContents
For Each c In Range("S6:S" & Rows.Count).SpecialCells(2)
    ReDim Preserve dt(ctr)
    dt(ctr) = c.Value
    ctr = ctr + 1
Next c
ctr = 0

For Each c In Range("N6:N" & Range("L" & Rows.Count).End(xlUp).Row)
If c.Value = "確認" Then
c.Offset(, -1).Value = dt(ctr): ctr = ctr + 1: If ctr > UBound(dt) Then Exit For
Else
c.Offset(, -1).Value = c.Offset(, -2).Value
End If
Next c

End Sub

試したこと

コードの"確認"を他の文字に変更するとL列の値のある最終行までの値が
入力された　

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

tatsu99

2019/11/26 08:59

>コードの"確認"を他の文字に変更するとL列の値のある最終行までの値が入力された　コード中に"確認"の文字はありません。どうなってますか。なさりたいことがよくわからないので、レイアウトが判るように実行前の画像と、実行後の期待する結果の画像を提示していただけませんでしょうか。

ichigo15

2019/11/27 00:11

説明が不足しており申し訳ございません。＞コード中に"確認"の文字はありません。どうなってますか。文字化けしていたので修正いたしました。画像を添付しましたのでご確認ください。まだ分かりにくいようでしたらご連絡下さい。よろしくお願いいたします。

行動規範の内容に同意します

回答1件

ベストアンサー

修正しました。
修正点は以下の個所です。
１．For Each c In Range("N6:N" & Range("L" & Rows.Count).End(xlUp).Row)
のNの最終行は、L列、N列の最終行の大きいほうを採用するようにしました。
２．N列の「確認」の数がS列の数より大きい場合、M列は空白を設定するようにしました。
（現行は「確認」の数がS列の数より大きい場合、繰り返しを打ち切っているので、そこで止まっています）

VBA
1Sub てすと()
2
3    Dim dt(), ctr As Long, c As Range
4    Dim Lmax As Long
5    Dim Nmax As Long
6    Range("M6:M" & Rows.Count).ClearContents
7    For Each c In Range("S6:S" & Rows.Count).SpecialCells(2)
8        ReDim Preserve dt(ctr)
9        dt(ctr) = c.Value
10        ctr = ctr + 1
11    Next c
12    ctr = 0
13    Lmax = Cells(Rows.Count, "L").End(xlUp).Row 'L列 最終行を求める
14    Nmax = Cells(Rows.Count, "N").End(xlUp).Row 'N列 最終行を求める
15    If Lmax > Nmax Then Nmax = Lmax             'Lmax,Nmaxの大きいほうをNmaxとして採用する
16    For Each c In Range("N6:N" & Nmax)
17        If c.Value = "確認" Then
18            If ctr > UBound(dt) Then            '配列上限を超えていれば空白を設定
19                c.Offset(, -1).Value = ""
20            Else
21                c.Offset(, -1).Value = dt(ctr)
22            End If
23            ctr = ctr + 1
24        Else
25            c.Offset(, -1).Value = c.Offset(, -2).Value
26        End If
27    Next c
28
29End Sub