アプリ版:「スタンプのみでお礼する」機能のリリースについて

Excel2013のVBAについてです。

入力シートのA列に抽出用のNo.、B列に職員番号、C列に正規の有無、D列に◯×と記入した表があります。(※抽出番号はダブりなし、職員番号は同じ番号が複数個あります。)
その際に、C列が正規で、且つD列が◯の職員の抽出番号を、出力シートA4から一定間隔(5行間隔)で出力するVBAを作りました。
---------
Set s1 = Worksheets("入力シート")
Set s2 = Worksheets("出力シート")
c = Array(4, 9, 14, 19, 24, 29, 34, 39, 44, 49) '貼り付ける行番号(5から50行へ5つ間隔で)
For i = 1 To s1.Cells(s1.Rows.Count, 2).End(xlUp).Row 
If s1.Cells(i, 3).Value = "正規" And s1.Cells(i, 4).Value = "◯" Then '検索条件
n = s1.Cells(i, 2).Value - 1
c(n) = c(n) + 1
s2.Cells(c(n),1).Value = s1.Cells(i, 1).Value '貼付け
End If
Next i
---------

この際に職員番号が5つ以内であれば、5つ間隔に収まるので良いのですが、5つを超えた場合に、はみ出た数字が、次の職員番号に上書きされてしまいます。
もし、職員番号が5つを超えた場合、6以降の数字を次のセルへ貼り付けるような命令はできますでしょうか。

A 回答 (1件)

こんんちは!



細かい検証はしていませんが・・・

Sub Sample1()
Dim i As Long, cnt As Long
Dim wS As Worksheet
Set wS = Worksheets("出力シート")
With Worksheets("入力シート")
For i = 1 To .Cells(Rows.Count, "B").End(xlUp).Row
If .Cells(i, "C") = "正規" And .Cells(i, "D") = "○" Then
cnt = cnt + 1
wS.Cells(cnt * 5 - 1, "A") = .Cells(i, "A")
End If
Next i
End With
End Sub

こんな感じをお望みなのでしょうか?

※ 質問文では
>A4から一定間隔(5行間隔)で
とありますが、コードのコメントには
>'貼り付ける行番号(5から50行へ5つ間隔で)
となっていますので、質問文通り
上記コードはA4 → A9 → A14 ・・・
となります。

5行目から始める場合は、コード内の
> wS.Cells(cnt * 5 - 1, "A") = .Cells(i, "A")

>wS.Cells(cnt * 5, "A") = .Cells(i, "A")
に変更してみてください。m(_ _)m
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!