| 
    
     |  | ▼ごん さん: 
 >結合セルの列も削除されると最高なのですが。
 
 そうですね。
 で、こうするには、上でコメントしましたように、配列での上書きではなく
 (自分としては好きじゃないんですが)物理的な列の削除を行うことになりますね。
 列削除コードについてはすでにkanabunさんからご提示がありますので、かわりばえがないのですが
 私のコードを踏まえて「無理やり」対応するなら以下でしょうか。
 
 Sub Sample3()
 '列削除方式
 Dim myA As Range
 Dim lCell As Range
 Dim z As Long
 Dim i As Long
 Dim j As Long
 Dim k As Long
 Dim vCols As String
 
 Application.ScreenUpdating = False
 
 With ActiveSheet.UsedRange
 Set lCell = .Cells(.Cells.Count)
 End With
 Set myA = Range("A3", lCell)
 vCols = getCols(lCell.Column)
 
 For j = lCell.Column To 1 Step -1
 
 If InStr(vCols, vbTab & j & vbTab) > 0 Then
 If WorksheetFunction.CountBlank(myA.Columns(j)) _
 = myA.Rows.Count Then Columns(j).Delete
 End If
 Next
 
 Application.ScreenUpdating = True
 
 MsgBox "処理が完了しました"
 
 End Sub
 
 Private Function getCols(mCols As Long) As String
 Dim a As Range, b As Range
 Dim s As String
 For Each a In Selection.Areas
 For Each b In a.Rows(1).Cells
 s = s & vbTab & b.Column
 Next
 Next
 getCols = s & vbTab
 End Function
 
 
 |  |