It won't hurt to try

[VBA]시트행지우기2 본문

VBA

[VBA]시트행지우기2

yongki.doki 2022. 9. 14. 17:24
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