VBA 特定の文字の横に表示

Question

特定の文字の横にファイル名を表示させるVBAを教えて下さい。

添付画像のように【有】と【無】の文字がP4セルからP11セルにはいっています。
このエクセルファイルが保存されているフォルダ内のPDFの名前を
【有】と表示されている隣のセルQ4、Q7～Q11セルに表示されるようにするには
どうすればよいでしょうか。

現在のマクロだと、【無】の所をとばした際に
ファイル名も次のファイルに移動してしまい正しく取得できません。

Sub test()
Dim buf As String
Dim fp As String
Dim i As Long

fp = ThisWorkbook.Path & "\"

With CreateObject("System.Collections.ArrayList")
buf = Dir(fp & "*.pdf")
Do While buf <> ""
.Add Format(FileDateTime(fp & buf), "YYYYMMDDHHNNSS") & buf
buf = Dir()
Loop
.Sort

For i = 0 To .Count - 1
If Cells(i + 4, 16) = "有" Then
Cells(i + 4, 17) = Mid(.Item(i), 15)
Else
i = i - 1
End If
Next i
End With
End Sub

Comments

[meg_]

コードは「コードの挿入」で記入してください。

[yuya_i]

申し訳ありません。これでよろしいでしょうか。

[meg_]

インデントがないままなので、コードが読みにくいです。
セルを指定するインデックスとファイル名を指定するインデックスを分ければ良いのではないでしょうか？

Answer 1

ArrayList用の変数と、出力セル指定用の変数を別に用意しないとだめでしょう。

'前略
        j = 3
        For i = 0 To .Count - 1
            Do
                j = j + 1
                If Cells(j, 16) = "" Then
                    Exit For
                ElseIf Cells(j, 16) = "有" Then
                    Cells(j, 17) = Mid(.Item(i), 15)
                    Exit Do
                End If
            Loop
        Next i
'後略

別案

セル範囲の方を For Each でループさせた方がシンプルになりますね。

'前略
        Dim c As Range
        For Each c In Cells(4, 16).CurrentRegion
            If i > .Count - 1 Then Exit For
            If c = "有" Then
                c.Offset(, 1) = Mid(.Item(i), 15)
                i = i + 1
            End If
        Next

'後略

Comments

[yuya_i]

ありがとうございます。
教えて頂いたコードでやりたい事ができました。
考え方など参考になりました。
ありがとうございました。

Answer 2

これでどうでしょう。

二つ目のループについて、
セルの確認（有or無）をする変数iの外に
配列のカウントアップをするjを追加して、
セルが無のときにも配列のカウントアップが進んでしまわないようにしています。

Sub test()
Dim buf As String
Dim fp As String
Dim i As Long
Dim j As Long
j = 0

fp = ThisWorkbook.Path & "\"

With CreateObject("System.Collections.ArrayList")
buf = Dir(fp & "*.pdf")
Do While buf <> ""
.Add Format(FileDateTime(fp & buf), "YYYYMMDDHHNNSS") & buf
buf = Dir()
Loop
.Sort

For i = 0 To .Count - 1
If Cells(i + 4, 16) = "有" Then
Cells(i + 4, 17) = Mid(.Item(j), 15)
j = j + 1
Else
i = i + 1
End If
Next i
End With
End Sub

Comments

[yuya_i]

ありがとうございます。
頂いたコードで目的の動作が確認できました。
ありがとうございました。

Answer 3

For-Nextとは別の変数を使った場合の例です。Do-Loopが無限ループにならないよう注意が必要です。

Dim j As Integer
For i = 0 To .Count - 1
  Do Until Cells(j + 4, 16).Value = "有" Or Cells(j + 4, 16).Value = ""
    j = j + 1
  Loop
  Cells(j + 4, 17).Value = Mid(.Item(i), 15)
Next i
'For i = 0 To .Count - 1
'  If Cells(i + 4, 16) = "有" Then
'    Cells(i + 4, 17) = Mid(.Item(i), 15)
'  Else
'    i = i - 1
'  End If
'Next i

Comments

[yuya_i]

ありがとうございました。
目的が果たすことができました。