[Excel VBA]空白行を上方向に削除して詰める

Question

前提・実現したいこと

ある発注機関の発注機関コードおよび組織名をまとめたExcelファイルから、MySQLにあるテーブル「t_発注機関」の挿入・更新・削除を行うSQL文を新しいシートに書き出すマクロを作成しています。

EXCELファイルのテーブルは以下の通りです。
4列目が更新する組織名、5列目がINSERT/UPDATE/DELETE文を作成するかを判断する項目です。
5列目で「-」はチェック済、空白セルは未チェックを意味しています。

ID	発注機関コード	取引先	w_取引先	チェック
1	11111	AAA		-
2	22222	BBB	new_BBB	名称変更
3	33333	CCC		削除
4	44444	DDD		新規設置
5	55555	EEE
6	66666	FFF		新規設置

このテーブルから、新しいシートに以下のようなSQL文が出力されるようにし、
5列目が「-」または空白の時に作成される空白セルを削除し、上方向に詰めるようにしたいです。

• UPDATE t_発注機関 SET 取引先 = 'new_BBB' WHERE id = '2';
• DELETE FROM t_発注機関 WHERE id = '3';
• INSERT INTO t_発注機関 VALUES ('4','44444','DDD',);
• INSERT INTO t_発注機関 VALUES ('6','66666','FFF',);

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

マクロを実行すると、新しいシートに書き込み、途中の空白行は上詰めで削除されるのですが、
以下のように、先頭行の空白セルが削除されずに残ってしまいます。

• (空白)
• UPDATE t_発注機関 SET 取引先 = 'new_BBB' WHERE id = '2';
• DELETE FROM t_発注機関 WHERE id = '3';
• INSERT INTO t_発注機関 VALUES ('4','44444','DDD',);
• INSERT INTO t_発注機関 VALUES ('6','66666','FFF',);

該当のソースコード

作成したソースコードは以下の通りです。

Option Explicit

Sub createSql()
    With ActiveSheet
        '新しいSheetの作成
        Dim newsheet As Worksheet
        Set newsheet = Worksheets.Add
    
        'SQL文の作成
        Dim sql As String
        Dim i As Long
        
        '条件分岐
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
                If .Cells(i, 5) = "名称変更" Then
                    sql = "UPDATE t_発注機関 SET " & "取引先 = '" & Cells(i, 4) & "' WHERE id = " & Cells(i, 1) & ";"
               
                ElseIf .Cells(i, 5) = "新規設置" Then
                        sql = "INSERT INTO t_発注機関 VALUES " & "('" & Cells(i, 1) & "','" & Cells(i, 2) & "','" & Cells(i, 3) & "')" & ";"
               
                ElseIf .Cells(i, 5) = "削除" Then
                      sql = "DELETE FROM t_発注機関 WHERE id = " & Cells(i, 1) & ";"
                      
                ElseIf .Cells(i, 5) = "-" Then
                      sql = ""
                      
                Else
                      sql = ""
        
                End If
                
               '新しいSheetに書き込み
               newsheet.Cells(i - 1, 1).Value = sql
                        
        Next
        
        '空白セルを上詰め削除
        Dim MyRng As Range
        Set MyRng = ActiveSheet.UsedRange '処理する範囲を選択
        MyRng.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp '範囲に含まれる空白行を削除
 
    End With
        
End Sub

試したこと

一行目の空欄を無視するように設定していることが考えられますが、一行目から始める方法が分からず困っています。
書き込むセルを最初から指定するコードを追加するほうがよろしいでしょうか。
良いアイデアがありましたら、ご教示いただきますよう、何卒よろしくお願いいたします。

Answer 1

空のSQL(sql = "")も出力して、後からそれを削除するより、最初から空のSQLは出力しないようにすればいいのでは。

また、sqlに代入する行の Cells は .Cellsというようにドットが必要です。ないと、ActiveSheetが対象になりますが、この時点では、newsheet がActiveSheetになりますので。

あと、If Then ElseIf Then を使うより、 Select Case の方がスッキリすると思います。

Sub createSql()
    With ActiveSheet
        '新しいSheetの作成
        Dim newsheet As Worksheet
        Set newsheet = Worksheets.Add
    
        'SQL文の作成
        Dim sql As String
        Dim i As Long, j As Long
                
        '条件分岐
        For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            Select Case .Cells(i, 5)
            Case "名称変更"
                sql = "UPDATE t_発注機関 SET " & "取引先 = '" & .Cells(i, 4) & "' WHERE id = " & .Cells(i, 1) & ";"
            Case "新規設置"
                sql = "INSERT INTO t_発注機関 VALUES " & "('" &. Cells(i, 1) & "','" & .Cells(i, 2) & "','" & .Cells(i, 3) & "')" & ";"
            Case "削除"
                sql = "DELETE FROM t_発注機関 WHERE id = " & .Cells(i, 1) & ";"                      
            Case "-"
                sql = ""
            Case Else
                sql = ""
            End Select
                
            '新しいSheetに書き込み
            If sql <> "" Then
                j = j + 1
                newsheet.Cells(j, 1).Value = sql
            End If
        Next
    End With
End Sub

Comments

[syu2048]

回答ありがとうございます。
空のSQLをそもそも書き込まないようにするというのが思いつかなかったので、
気づくことができ助かりました。
また、select case と if then の違いがいまいち理解しきれていなかったので、このコードをきっかけに分かったと思います。
こちらをベストアンサーとさせていただきます、ありがとうございました。

Answer 2

Set MyRng = ActiveSheet.UsedRange '処理する範囲を選択
ActiveSheet.UsedRange が 親切に一番上の空白はUsedしていないので、
2行目から範囲として認識するのかな？
で、
その範囲に対して
MyRng.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlShiftUp '範囲に含まれる空白行を削除
するから、
一番上が空白行なら、MyRngの範囲に入っていないので、削除されないとか？

ActiveSheet.UsedRange.Select すると、イメージがわくかなぁ。

外していたらスミマセン。何かの参考となれば・・・・

Comments

[ken3memo]

i で 行がわかるので、
Set MyRng = ActiveSheet.Range("A1:E" & i)
とか

[syu2048]

回答ありがとうございます。
Excelで同じ動作を確認しました。
おそらくExcelのおせっかいで上の空白を読み込まないようにしたのかもしれませんね。
範囲の取り方はよく考えながら行うようにします。