Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


12094 / 76734 ←次へ | 前へ→

【70166】Re:列が空白ならば削除したい
回答  UO3  - 11/10/18(火) 10:27 -

引用なし
パスワード
   ▼ごん さん:

>結合セルの列も削除されると最高なのですが。

そうですね。
で、こうするには、上でコメントしましたように、配列での上書きではなく
(自分としては好きじゃないんですが)物理的な列の削除を行うことになりますね。
列削除コードについてはすでに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
8 hits

【70129】列が空白ならば削除したい ごん 11/10/17(月) 7:47 質問
【70132】Re:列が空白ならば削除したい UO3 11/10/17(月) 9:40 発言
【70136】Re:列が空白ならば削除したい UO3 11/10/17(月) 10:11 発言
【70141】Re:列が空白ならば削除したい UO3 11/10/17(月) 11:06 回答
【70145】Re:列が空白ならば削除したい ごん 11/10/17(月) 11:42 質問
【70144】Re:列が空白ならば削除したい UO3 11/10/17(月) 11:38 回答
【70146】Re:列が空白ならば削除したい ごん 11/10/17(月) 11:48 質問
【70148】Re:列が空白ならば削除したい UO3 11/10/17(月) 11:57 発言
【70149】Re:列が空白ならば削除したい UO3 11/10/17(月) 12:48 回答
【70151】Re:列が空白ならば削除したい ごん 11/10/17(月) 13:57 発言
【70156】Re:列が空白ならば削除したい UO3 11/10/17(月) 17:40 回答
【70159】Re:列が空白ならば削除したい ごん 11/10/18(火) 9:06 お礼
【70166】Re:列が空白ならば削除したい UO3 11/10/18(火) 10:27 回答
【70150】Re:列が空白ならば削除したい kanabun 11/10/17(月) 12:53 発言
【70152】Re:列が空白ならば削除したい ごん 11/10/17(月) 15:59 お礼

12094 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free