[[20201225110640]]　『マクロで空白を埋める』（南風）　ページの最後に飛ぶ

『マクロで空白を埋める』（南風）

　 A　 B
1 東京
2
3 aaa
4 aaa
5 aaa
6　大阪 aaa
7　　 aaa
8 aaa
9 aaa
10 aaa
11　京都 aaa
12 aaa
13 aaa
14 aaa
15 aaa
16 福岡 aaa
17 aaa
18 aaa
19 aaa
20 aaa

A列に5行おきに都市名が入っており、それをコピーし空白を埋める方法を教えてください。
1-5行目　東京
6-10 大阪
11-15 京都
16-20 福岡

For i = 1 to 5 step 5
Cells(i,1).copy
Range(Cells(i+1,1),Cells(i+4)).PasteSpecial
Next i

???

ここまでしか思いつかず、もちろん間違っているわですが。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

テーブルがズレているので書き直します、
（B列には全部aaaと入っています）

 　　A　　　　B
1　　東京
2　　
3
4
5　　
6　　大阪　
7
8
9
10　　
11   京都
12
13
14
15
16　 福岡
17
18
19
20
　
（南風） 2020/12/25(金) 11:30

シート指定していません。
重複しません。
B1セルを基準に結果を貼り付けます。
コンパイルエラーしか見ていません。
参考に。

 Sub sample()
     Dim c As New Collection
     Dim lastRow As Long
     Dim v As Variant
     Dim temp() As String
     Dim i As Long
     lastRow = Cells(Rows.Count, "A").End(xlUp).Row

     On Error Resume Next
     For Each v In Range("A1:A" & lastRow).Value
         If Len(v) > 0 Then c.Add v
     Next v
     On Error GoTo 0
     If c.Count = 0 Then Exit Sub

     ReDim temp(1 To c.Count, 1 To 1)
     For i = 1 To c.Count
         temp(i, 1) = c(i)
     Next i
     Set c = Nothing

     Range("B1").Resize(UBound(temp, 1), UBound(temp, 2)).Value = temp
     Erase temp
 End Sub

（tkit） 2020/12/25(金) 12:00

 [test]は一番最初に思い付いたやつです。
 普段から手作業でやっているのをコードに直すとこんなかな？と。

 [test2]は、南風さんのマクロをちょっと手直ししてみたやつです。
 一応、どちらも動作は確認しておりますが、どうでしょうか？(^^;

 Option Explicit

Sub test()

    Rows(1).AutoFilter field:=1, Criteria1:=""
    Range("A2", Range("B2").End(xlDown).Offset(, -1)).Formula = "=A1"
    Rows(1).AutoFilter
    Range("A2", Range("A2").End(xlDown)).Value = Range("A2", Range("A2").End(xlDown)).Value

End Sub

Sub test2()

    Dim i As Long

    For i = 1 To 20 Step 5
        Cells(i, 1).Copy
        Range(Cells(i + 1, 1), Cells(i + 4, 1)).PasteSpecial xlPasteValues
    Next i
    Application.CutCopyMode = False

End Sub

（虎） 2020/12/25(金) 12:07

 南風さんのコードいいと思います！！
 ＞For i = 1 to 5 step 5 
               ~↑~
 ここのお尻を最後の行＋４にしてあげて

 ＞Range(Cells(i+1,1),Cells(i+4)).PasteSpecial 
                              ~↑~
 ここの第2引数をチャンと指定してあげれば、動きますよ！

 コピーペーストしなくてもよさそうだったので、何かの足しにしてください。

    Sub a()
        Dim i As Long
        With Sheets("Sheet1")
            For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row + 4 Step 5
                .Cells(i + 1, "A").Resize(4).Value = .Cells(i, "A").Value
            Next i
        End With
    End Sub

（稲葉） 2020/12/25(金) 12:37

別案で。

＞空白を埋める方法
↑に注目すると以下のようなプロセスでも対応できると思います

 (1) A1～A20までを選択する
 (2) ctrl + G を押してジャンプメニューを呼び出して「セル選択」を選択
 (3) 「空白セル」を選択して「OK」を押下
 (4) 複数セルが選択された状態になるので、そのまま「=」と入力して↑キーを1回押す
 (5) ここまでで数式バーには「=A1」のような数式が書き込まれているので【ctrlを押しながら】確定する
 (6) これで、選択されていた空白セルすべてに1つ上のセルを参照する数式が書き込まれる
 (7) もう一度、A1～A20までを選択しなおして、コピーしたあと、形式を選択して貼り付け-値

これをVBAで表現すると、こんな感じです。

    Sub さんぷる()
        With Range("A1:A20")
            .SpecialCells(xlCellTypeBlanks).Formula = "=A1"
            .Value = .Value
        End With
    End Sub

実際には、最終行がいつも一緒だとは限らないと思いますので、最終行や最終セルをしらべてから同じ考え方をすればよいとおもいます。

 With Range("A1:A" & Cells(Rows.Count, "B").End(xlUp).Row)  ←B列の最終行を調べてみる
 With Range("A1", Cells(Rows.Count, "A").End(xlUp).Offset(4)) ←A列の最終セルから４つ下のセルまでを対象にする

興味があればステップ実行して研究してみてください。

（もこな２） 2020/12/25(金) 13:19

提示したコードに誤りがありましたので修正しました。

（もこな２） 2020/12/25(金) 13:33

皆さんすごいです。。

しかし今の私には難解すぎて解読不可能です。
虎さんのtest2が私のレベルで理解できたのでそちらを使わせていただきます。
他の方の案も解読できるよう精進します。
（南風） 2020/12/25(金) 14:40

コメント返信：

[ 一覧(最新更新順) ]

[[20201225110640]] 『マクロで空白を埋める』（南風） ページの最後に飛ぶ

[[20201225110640]]　『マクロで空白を埋める』（南風）　ページの最後に飛ぶ