[[20191225171659]]　『VBAでDeleteが何度か実行しないときちんと実行さａx（ももぞの）　ページの最後に飛ぶ

『VBAでDeleteが何度か実行しないときちんと実行されない』（ももぞの）

もし知っておられたら教えて頂けますと助かります。
質問要点としては２点です。

1）B列で空白があれば行を削除するように書いているのですが、
　一回の実行だと削除しきれない行が何故かあります。
　エラーは特に出ずに３回くらい同マクロを実行すると
　削除予定データがきちんと消えるのですが、
　なぜ一回で消えないのでしょうか？
　わかるかたおられたら教えて頂けますと助かります。

'B列が空白だったら行を消して上に詰める()
For copy = 1 To last
If Range("b" & copy).Value = "" Then

    Range(Cells(copy, 1), Cells(copy, 2)).Select
    Selection.Delete Shift:=xlUp

2）マクロ全体は以下の通りなのですが、
VBAはじめたばかりなので、
もっと良い書き方などあればご指摘頂けますと助かります。

例えばFor copyは２回使っちゃっているのですが、
もっとまとめて書けないかとか考えていました。

１行データを２行に変換して、
Wordの差し込みデータにしてから印刷を
させようとしているものです。
まだWordの連携をどうしようか考えているところで、
最終的にはマクロ実行すると差し込みの全データ印刷が
実行されてプリンタ選択画面に以降するようにしたいと思っています。

Sub 宛名シールの差し込みデータ()
'入荷シリアルシートにシリアルの記載が無い時に警告を出す
If Range("a2") = "" Then

    MsgBox ("A列にシリアルの記載が無いです")
        End
    Else
End If
'AとB列の１列目にタイトル入る
Range("a1").Value = "Product"
Range("b1").Value = "Serial"

'A列を選択して空白セルを上に詰める
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp

'もし頭文字が数字なら右上にデータを移動する
'もしB列が空行なら列を上に移動削除
'2文字目が数字だったらシリアルを右側に移動させてる
Dim copy As Integer
Dim last As Integer

'最終行を取得している
last = Range("A6000").End(xlUp).Row
For copy = 0 To last
　　If Not IsNumeric(Mid(Range("a" & 2 + copy), 2, 1)) Then
Else
Range("b" & 1 + copy).Value = Range("a" & 2 + copy).Value
Range("a" & 2 + copy).Clear
End If
Next copy

'B列が空白だったら行を消して上に詰める()
For copy = 1 To last
If Range("b" & copy).Value = "" Then

    Range(Cells(copy, 1), Cells(copy, 2)).Select
    Selection.Delete Shift:=xlUp
Else
End If
Next copy

'印刷指定位置のために空行挿入
Dim space As Integer

    space = Range("e16").Value + 1
    Range(Cells(2, 1), Cells(space, 2)).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

'印刷実行

End Sub

以上です。どうぞよろしくお願いいたします。

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

1つ目は、上から下に回すのではなく、下から先に処理するよう、Forループを逆にしてみてください。
（上から消すと、消した分行が詰まってしまい、ループ変数と整合性が取れなくなる）

2つ目は…、いっぱいありすぎるので、ちょっとパスです。
（???） 2019/12/25(水) 18:05

＞'A列を選択して空白セルを上に詰める
＞Columns("A:A").Select
＞Selection.SpecialCells(xlCellTypeBlanks).Select
＞Selection.Delete Shift:=xlUp

B列も、↑と同じようにしてはどうでしょうか。

（マナ） 2019/12/25(水) 18:36

んと。。。

シートのイメージも提示していただけませんか？
微妙なセル位置とか、コードを読んだだけでは混乱します＾＾；
（まっつわん） 2019/12/25(水) 19:12

皆様
アドバイス頂きありがとうございます。

○？？？様
以下の感じに
For 1 to 50を
For　50 to 1にしてみたのですが改善できませんでした・・。
改善策あればご教示頂けますと助かります。

Sub B列が空白だったら行を消して上に詰める()
Dim copy As Integer
For copy = 1 To 50
If Range("b" & copy).Value = "" Then

    Range(Cells(copy, 1), Cells(copy, 2)).Select
    Selection.Delete Shift:=xlUp
Else
End If
Next copy
End Sub

○マナ様
すいません、B列の空データがあれば、
A列と一緒に消したいので、これに単純にBを足しても
A列が残ってしまい空行が上に詰まるだけなので希望動作にならないのです。
わかりにくい説明で申し訳無いです。

○まっつわん様
製品と製品コードがごちゃまぜになったデータが１列に
あるのを、Wordへの差し込みデータとるすために
２列に整列させたいのです。

しかし製品名も製品コードも英語と数字がごちゃまぜで
作られているので、頭から２文字目が数字だったら
B列に製品コードを移動してA列を製品名、B列に製品コードを
整列させてWordの宛名データとして活用するつもりでした。

説明がわかりにくかったら申し訳無いです。
どうぞよろしくお願いいたします。

○元データ：
（A列）
AAAABBBBB
AAAABBBBB
123AA1233
CCCDDDDDD
123AA1233
EEEESSSSS
123AA1233

↓
○仕上がりイメージ：
（A列）（B列）
AAAABBBBB　123AA1233
CCCDDDDDD　123AA1233
EEEESSSSS　123AA1233

以上です。どうぞよろしくお願いいたします。

（ももぞの） 2019/12/27(金) 13:24

1）B列で空白があれば行を削除する～

1.B列データ範囲をRange型変数に格納
2.For Eachで、1.の変数の各セルを回す
3.セルが空白判定なら、セル.EntireRow.delete Shift:=xlShiftUp　で行削除

という考え方はいかがでしょうか。
（tkit） 2019/12/27(金) 14:20

な～んか、難しく考えすぎじゃないですかね？

1）A列を順に見て行く
2）もし、先頭2文字が数字なら（数値変換可能なら）
3）右上のセルに転記
4）次へ
5）全部見たら（ループが終ったら）B列の空白セルの行全体を削除

こんな感じでいいのでは？

Sub test()

    Dim c As Range

    For Each c In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
        If IsNumeric(Mid(c.Value, 1, 2)) = True Then
            c.Offset(-1, 1).Value = c.Value
        End If
    Next
    Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

（まっつわん） 2019/12/27(金) 15:09

A列に空白があろうがなかろうが、
B列に転記しても空白は空白なので、
最終的には削除の対象になりますよね？（たぶん）
（まっつわん） 2019/12/27(金) 15:12

 >For　50 to 1にしてみたのです 
 Step -1 つけてないとか
（´・ω・`） 2019/12/27(金) 15:41

皆様、明けましておめでとうございます、返信ありがとうございます。

○tkit様
ごめんなさい、ちょっと意味が違うのです。

○（´・ω・`）様
行を削除するときのStep-1の事を知らなかったのです。
教えていただきありがとうございます。

○まっつわん様
ご教示ありがとうございます。
バッチリです。凄くスッキリ書かれていてビックリしました。
AB列以外のC列以降は並び替えたくないので、
AB列限定にしたいのですが、可能でしょうか？
自分で調べてやってみたのですが、
うまく動作範囲を限定することができませんでした・・・。
後学のためにも教えて頂けますと助かります。

（ももぞの） 2020/01/09(木) 16:18

　＞凄くスッキリ書かれていて

こういうのは慣れなので、
沢山コードを書いたり、
掲示板等でたくさん他人のコードを見て、
覚えてください。

　＞AB列限定にしたいのですが

ならば、そう書けばよいのです。

　＞Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Intersect(Range("A:B"),Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow).delete xlShiftUp

とか、

Range("B:B").SpecialCells(xlCellTypeBlanks).Resize(,2).Offset(,-1).delete xlShiftUp

とかかなぁ。。。。。
直接ここに書いたので間違っていたらごめんなさいです。

参考URL＞
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_cell.html
http://officetanaka.net/excel/vba/tips/tips118.htm
https://www.officepro.jp/excelvba/cell_edit/index1.html

この辺を見て研究してみてください。
（まっつわん） 2020/01/09(木) 17:59

まっつわん様

ご返信と丁寧にご教授頂きありがとうございます。
今後も精進してまいります。

URLも一つずつみていきます。
ありがとうございます。
（ももぞの） 2020/01/14(火) 17:58

コメント返信：

[ 一覧(最新更新順) ]

[[20191225171659]] 『VBAでDeleteが何度か実行しないときちんと実行さａx（ももぞの） ページの最後に飛ぶ

[[20191225171659]]　『VBAでDeleteが何度か実行しないときちんと実行さａx（ももぞの）　ページの最後に飛ぶ