It won't hurt to try
[VBA]시트행지우기2 본문
Sub deleteButton2_clicked()
' Const
Const update As String = "update"
Const hyphen As String = "-"
Const Oh As String = "O"
Const search_start As String = "C3"
Const delete_standard_cell As String = "C3"
' Dim
Dim sheet_name As String
Dim rMulti As Range
Dim remove_rows As String
Dim remove_columns As String
Dim list As Variant
Dim index As Integer
' init
ReDim list(0)
index = 0
' Exit Sub
If Range(search_start).Value = "" Then
Exit Sub
End If
' select cells
Range(search_start, ActiveSheet.Range(search_start).End(xlDown)).Select
' get rows for delete address
Set rMulti = Selection.Cells()
For Each rCol In rMulti.Columns
For Each rCell In rCol.Rows
If update = Range(rCell.Address).Value Then
'sheet_name
sheet_name = Range(rCell.Address).Offset(, 1).Value
'index
index = 0
remove_columns = ""
ReDim list(0)
ElseIf hyphen = Range(rCell.Address).Value Then
'list
list(UBound(list) - LBound(list)) = Range(rCell.Address).Offset(, 1).Value
ReDim Preserve list(UBound(list) - LBound(list) + 1)
'remove_rows
remove_rows = remove_rows + rCell.Address + ","
'index
index = index + 1
ElseIf Oh = Range(rCell.Address).Value Then
'index
index = index + 1
End If
If index > 0 And (update = Range(rCell.Address).Offset(1, 0).Value Or IsEmpty(Range(rCell.Address).Offset(1, 0).Value)) Then
' list transformation
If UBound(list) - LBound(list) >= 1 Then
ReDim Preserve list(UBound(list) - LBound(list) - 1)
End If
' search columns
For Each Item In list
Set deleteColumnRange = Sheets(sheet_name).Range(delete_standard_cell, Sheets(sheet_name).Range(delete_standard_cell).Offset(0, index * 2 - 1))
For Each lCol In deleteColumnRange.Columns
For Each lCell In lCol.Rows
If Item = lCell.Value And Not IsEmpty(lCell.Value) Then
remove_columns = remove_columns + lCell.Address + "," + lCell.Offset(1, 0).Offset(0, 1).Address + ","
End If
Next lCell
Next lCol
Next Item
If "" <> remove_columns Then
remove_columns = Left(remove_columns, Len(remove_columns) - 1)
' delete columns
Sheets(sheet_name).Range(remove_columns).EntireColumn.Delete
End If
End If
Next rCell
Next rCol
If "" <> remove_rows Then
remove_rows = Left(remove_rows, Len(remove_rows) - 1)
Range(remove_rows).EntireRow.Delete
End If
MsgBox "Complete"
End Sub
테스트 세팅
테스트 결과
300x250
300x250
'VBA' 카테고리의 다른 글
모든 시트의 표시형식을 바꾸기 (0) | 2022.12.19 |
---|---|
[VBA]시트행지우기1 (0) | 2022.08.29 |
text join 함수 (0) | 2020.10.30 |
다른 파일 시트에서 문자열 검색 (4) | 2020.10.07 |
Comments