| |
▼ごん さん：
オートフィルターによる処理案です。
２行目がタイトル行、かつ、２行目が結合されている列は選択できません。
（選択されればエラーメッセージをだして中断します）
Sub SampleA()
'オートフィルター
Dim myA As Range
Dim myR As Range
Dim lCell As Range
Dim z As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim v As Variant
Dim w() As Variant
Dim vCols As Variant
Dim allB As Boolean
Dim ct As Variant
With ActiveSheet.UsedRange
Set lCell = .Cells(.Cells.Count)
End With
vCols = checkCols(lCell.Column)
If Not IsArray(vCols) Then
MsgBox "タイトル行が結合されている列は選択できません"
Exit Sub
End If
Application.ScreenUpdating = False
Set myA = Range("A2", lCell)
'オートフィルター設定が残っていれば、いったんリセット
If ActiveSheet.AutoFilterMode Then _
ActiveSheet.AutoFilterMode = False
myA.AutoFilter
For Each ct In vCols
myA.AutoFilter Field:=ct, Criteria1:="="
Next
Set myR = Intersect(ActiveSheet.AutoFilter.Range, ActiveSheet.AutoFilter.Range.Offset(1))
If Not myR Is Nothing Then myR.EntireRow.Delete
myR.AutoFilter
Set myA = Nothing
Set myR = Nothing
Application.ScreenUpdating = True
MsgBox "処理が完了しました"
End Sub
Private Function checkCols(mCols As Long) As Variant
Dim a As Range, b As Range
Dim k As Long
Dim v() As Variant
Dim mc As Boolean
ReDim v(1 To mCols)
For Each a In Selection.Areas
For Each b In a.Rows(1).Cells
k = k + 1
v(k) = b.Column
If Cells(2, b.Column).MergeCells Then mc = True
Next
Next
If mc Then
checkCols = False
Else
ReDim Preserve v(1 To k)
checkCols = v
End If
End Function
|
|
UO3
- 11/10/17(月) 11:38 -
