' [113.xls]





' [Module1] のコード
'★★☆　空白セルを削除する　☆★★

Option Explicit

Sub start()

    UserForm1.Show

End Sub

Sub start_A()

    Sheets("作業シート").Visible = -1
    Sheets("Title").Visible = 2

End Sub

Sub start_B()

    Sheets("Title").Visible = -1
    Sheets("作業シート").Visible = 2
    
End Sub

Sub 罫線作成()

    [B6:F15].Select
        With Selection
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With

    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 3
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 3
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 3
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 3
    End With
    
End Sub


' [UserForm1] のコード
Option Explicit

Private Sub CommandButton1_Click()
Dim r As Integer    '行番号格納用
Dim c As Integer    '列番号格納用
Dim myrnd           'ランダムな文字、数値、格納用
                    '(宣言で型を明示しない場合はVariant型になります)

    '乱数の生成を利用してランダムな空白を含むデータベースを作成します
    'データになる文字や数字も乱数の生成とAsc 関数を利用しています
    For c = 2 To 6
        For r = 6 To 15
            myrnd = Chr(Int((122 - 47) * Rnd + 48))
                If (Asc(myrnd) < 65 And _
                        Asc(myrnd) > 57) Or _
                        (Asc(myrnd) < 122 And _
                        Asc(myrnd) > 90) Then
                        
                    Cells(r, c) = ""
                Else
                    Cells(r, c) = myrnd
                End If
        Next r
    Next c

    'データ範囲が出来上がった時点で、空白セルの削除ボタンを使用可能にする
    CommandButton2.Enabled = True

End Sub

Private Sub CommandButton2_Click()

    On Error Resume Next
    
    'この１行のコードで空白セルを削除しています
    [B6:F15].SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    
    'セルの削除により罫線が乱れてしまいますので
    'サブマクロで罫線を作成仕直します
    罫線作成
    
    [A1].Activate
    
End Sub

Private Sub UserForm_Initialize()

    '最初はデータ範囲にデータが無いので空白セル削除ボタンを使用不可にします
    CommandButton2.Enabled = False

    'フォームの位置指定
    Me.StartUpPosition = 2
    
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
            
    'フォーム終了時見やすく変更したワークシートの表示を元に戻す
    [B6:F15].ClearContents

End Sub