2018년 11월 7일 수요일

Excel VBA 파일(Book)의 모든 시트에 함수를 삭제하고 값만 남기기

외부로 파일 전달시 유용하다. (수식이 깨지거나 바뀌어서 값이 변동되는것 방지)

Sub MacroSaveValue()
With Application: .Calculation = 3: .ScreenUpdating = 0
On Error Resume Next: Dim w As Worksheet, v
For Each w In Sheets
v = w.UsedRange.Value: w.UsedRange = v
Next: Set w = Nothing: .Calculation = 1: End With

'MsgBox ("모든 시트의 내용을 Value(값)으로 저장 완료")
'MsgBox ("!저장할 때 수식을 잃어버리지 않도록 주의!")
End Sub


Excel VBA 특정 컬럼 명(1열) 만 남기고 삭제하기.

대량 작업시 유용...

Sub Delete_Cols_WithOut()

    Dim co As Long, I As Long
    Dim join As String

    co = ActiveSheet.Range("A1").CurrentRegion.Columns.Count '추가할 시트에 Cols count 를 알아옵니다
    
    Debug.Print ("#시트이름 : " + ActiveSheet.NAME)
    Debug.Print ("--컬럼 목록 시작")
    For I = 0 To co
        Cells(1, I + 1).Select
        join = Selection.Offset(0, 0) ' 비교할셀값 좌표
        Debug.Print (join)
    Next
    Debug.Print ("--컬럼 목록 끝")
    Debug.Print ("--------------------------------")

    Cells(1, 1).Select

    For I = 0 To co
        join = Selection.Offset(0, 0) ' 비교할셀값 좌표
        'Debug.Print (join)
    
            If join = "Key" Or join = "삭제할 시트명" Then
                Debug.Print ("찾음 : +" + join)
                Selection.Offset(0, 1).Select    
            Else
                Debug.Print ("삭제함 : -" + join)
                Selection.EntireColumn.Delete
    
            End If

    Next

End Sub

Excel VBA 시트마다 1셀 클릭으로 위치 초기화 하기

저장전에 해서 주면 다른 사람이 사용하기 좋다.
특별히 기능적인건 아님..

'1시트 1셀 클릭 초기화
Sub WorksheetLoop()

         Dim WS_Count As Integer
         Dim I As Integer
         WS_Count = ActiveWorkbook.Worksheets.Count

         For I = 1 To WS_Count

            Debug.Print ("시트 변경함 : " + ActiveWorkbook.Worksheets(I).NAME)
            ActiveWorkbook.Worksheets(I).Select
            Cells(1, 1).Select

         Next I

      End Sub

Excel VBA 해당 파일(Book)에서 돌면서 특정 시트 찾아서 지우기

특정 시트 찾아서 지우기
조금 고치면 여러 시트도 할 수 있다.
WS_NameFindKey 에 지정된 이름을 찾는다. (아래 코드는 ETC)

'폰트 생성과 관련된 시트 삭제
Sub RemoveFontSheet()

         Dim WS_Count As Integer
         Dim I As Integer
         
         Dim WS_Name As String
         Dim WS_NameFindKey As String

         WS_Count = ActiveWorkbook.Worksheets.Count
         Dim TargetEtc As Worksheet
         
' 루프를 돌면서 대상을 찾는다.
         WS_NameFindKey = "Etc"
         
         For I = 1 To WS_Count

            '시트 선택 후 초기화
            ActiveWorkbook.Worksheets(I).Select
            Cells(1, 1).Select
            
            Debug.Print ("현재시트 : +" + ActiveWorkbook.Worksheets(I).NAME)
            
            WS_Name = ActiveWorkbook.Worksheets(I).NAME
            
            If WS_Name = WS_NameFindKey Then
                Debug.Print ("시트 찾음 : +" + WS_Name)
                Set TargetEtc = ActiveWorkbook.Worksheets(I)
                
            End If
            
         Next I
         
        If TargetEtc Is Nothing Then
        Else
            TargetEtc.Delete
        End If

End Sub


Excel VBA 해당 시트의 모든 서식 지우기

엑셀 작업 하는게 많아져서 매크로 제작한 것 백업 겸 공유로 올림

Sub 서식지우기()

        Dim co As Long, I As Long
        Dim ro As Long, J As Long
        Dim join As String
        
        co = ActiveSheet.Range("A1").CurrentRegion.Columns.Count '추가할 시트에 Cols count 를 알아옵니다
        ro = ActiveSheet.Range("A1").CurrentRegion.rows.Count '추가할 시트에 Cols count 를 알아옵니다

    Debug.Print (co)
    Debug.Print (ro)

    Cells(1, 1).Select 'A1 부터 시작

    For I = 0 To co '진행
            join = Selection.Offset(0, 0) ' 비교할셀값 좌표
            Debug.Print (join) ' join 은 셀값
            Selection.EntireColumn.ClearFormats
            Selection.Offset(0, 1).Select
            
    Next
    
    For J = 0 To ro '진행
            join = Selection.Offset(0, 0) ' 비교할셀값 좌표
            Debug.Print (join) ' join 은 셀값
            Selection.EntireRow.ClearFormats
            Selection.Offset(1, 0).Select
            
    Next
    
End Sub