암호화(마스킹), 시트통합, 시트명 일괄 변경 등
부트캠프를 진행하면서 20개가 넘는 캠프의 발표자 체크를 진행할 일이 있었습니다. 이전에는 구글 스프레드시트로 발표자 체크를 관리했었는데요,
캠프 별로 개별 시트를 생성해서 발표자 체크를 하고
이를 무한 복붙으로 통합하는 작업을 했습니다.
이것이 꽤나 고통스러운 작업이어서, 이를 VBA 코드로 간단히 통합해보려고 합니다.
기존에 제가 관리하던 시트에는 개인 정보가 꽤 많아서 - 이를 여러분들에게 보여주기 위해 더미데이터화하는 작업부터 시작해보겠습니다. 원래 데이터의 형태는 아래와 같습니다.
첨부파일을 더미 데이터 형식으로 만들고 싶어. C 열의 이름과 E열의 이메일과 F 열의 전화번호와 G열의 전화번호를 일괄로 더미 데이터로 치환해줘. 모든 시트에 동일하게 작업해줘. 1. 실제 데이터는 5행부터 있어. 4행의 헤더는 그대로 유지하고 더미데이터를 만들어줘. 2. 텍스트가 포함되어 있는 행만 더미 데이터로 치환해줘. 3. 완전히 랜덤한 사람 이름, 전화번호, 메일 주소, 그리고 소속을 포함한 더미 데이터로 치환 작업해줘. 한국인 이름, 전화번호, 소속으로 바꿔줘. 4. c, e, f, g 열 말고는 건드리지마.
이리 하여 여러분들께도 공개 가능한 더미 데이터가 생성되었습니다.
매크로가 돌아가기 위해서는 저희에게 익숙한 xlsx 형태가 아닌 ‘xlsm’ 형태의 파일로 저장해야 합니다. 파일 > 다음이름으로 저장에서 xlsm 파일로 저장하기만 하면 됩니다.
그러면 아래와 같은 코드를 짜줍니다.
Sub 암호화하기()
Dim ws As Worksheet
Dim cell As Range
Dim i As Long
Dim name As String
Dim email As String
Dim phone As String
Dim affiliation As String
For Each ws In ThisWorkbook.Sheets
With ws
' 이름 암호화
For Each cell In .Range("C5:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
If Len(cell.Value) = 3 Then
cell.Value = Left(cell.Value, 1) & "**"
End If
Next cell
' 이메일 암호화
For Each cell In .Range("E5:E" & .Cells(.Rows.Count, "E").End(xlUp).Row)
email = cell.Value
If InStr(email, "@") > 0 Then
cell.Value = Left(email, 1) & String(InStr(email, "@") - 2, "*") & Mid(email, InStr(email, "@"))
End If
Next cell
' 전화번호 암호화
For Each cell In .Range("F5:F" & .Cells(.Rows.Count, "F").End(xlUp).Row)
phone = cell.Value
If Len(phone) > 4 Then
cell.Value = String(Len(phone) - 4, "*") & Right(phone, 4)
End If
Next cell
' 소속 암호화
For Each cell In .Range("G5:G" & .Cells(.Rows.Count, "G").End(xlUp).Row)
affiliation = cell.Value
If Len(affiliation) > 1 Then
cell.Value = Left(affiliation, 1) & String(Len(affiliation) - 1, "*")
End If
Next cell
End With
Next ws
MsgBox "암호화가 완료되었습니다.", vbInformation
End Sub
이 코드를 복사하고
alt(mac은 option) + F11 버튼을 누릅니다. 그럼 코드를 작성할 수 있는 창이 열립니다.
삽입 > 모듈을 선택하고 위에서 복사한 코드를 그대로 입력합니다.
그리고 F5를 눌러서 실행하면 짜라란 아래와 같이 민감 정보들이 사라집니다.
20개가 넘는 시트에 있는 자료를 일괄 ‘통합’이라는 시트를 만들어 합쳐보겠습니다.
Sub 시트통합하기()
Dim ws As Worksheet
Dim 통합Sheet As Worksheet
Dim 데이터시작행 As Long
Dim 데이터끝행 As Long
Dim 복사대상범위 As Range
Dim 통합시트행 As Long
' '통합' 시트 생성
On Error Resume Next ' 오류 무시
Set 통합Sheet = Sheets("통합")
If 통합Sheet Is Nothing Then
Set 통합Sheet = Sheets.Add(After:=Sheets(Sheets.Count))
통합Sheet.Name = "통합"
Else
통합Sheet.Cells.Clear ' 이미 존재하면 데이터 초기화
End If
On Error GoTo 0 ' 오류 무시 해제
' 첫 번째 시트의 4행을 '통합' 시트의 첫 번째 행으로 복사
Sheets(2).Rows(4).Copy Destination:=통합Sheet.Rows(1)
' 데이터 통합 시작
통합시트행 = 2 ' 헤더 다음 행부터 시작
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "통합" Then ' '통합' 시트는 제외
With ws
데이터시작행 = 5 ' 데이터 시작 행
데이터끝행 = .Cells(.Rows.Count, "A").End(xlUp).Row ' 데이터가 있는 마지막 행 찾기
' 데이터 복사 범위 설정
Set 복사대상범위 = .Range(.Cells(데이터시작행, 1), .Cells(데이터끝행, .Columns.Count))
' '통합' 시트에 데이터 복사
복사대상범위.Copy Destination:=통합Sheet.Cells(통합시트행, 1)
' '통합' 시트에서 다음 복사 위치 업데이트
통합시트행 = 통합시트행 + (데이터끝행 - 데이터시작행 + 1)
End With
End If
Next ws
MsgBox "'통합' 시트에 데이터 통합이 완료되었습니다.", vbInformation
End Sub
위와 같이 이 코드를 복사하고
alt(mac은 option) + F11 버튼을 누릅니다. 그럼 코드를 작성할 수 있는 창이 열립니다.
삽입 > 모듈을 선택하고 위에서 복사한 코드를 그대로 입력합니다.
그리고 F5를 눌러서 실행하면 짜라란 하나의 시트로 통합됩니다.
각 시트는 파트너들의 이름으로 저장되어 있었는데요, 이 또한 개인 정보니 이를 일괄 변경하겠습니다.
Sub 시트이름변경하기()
Dim ws As Worksheet
Dim 시트번호 As Integer
시트번호 = 1 ' 시작 번호 설정
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "통합" Then ' '통합' 시트는 이름 변경에서 제외
ws.Name = "7기_" & 시트번호 ' 시트 이름 설정
시트번호 = 시트번호 + 1 ' 시트 번호 증가
End If
Next ws
MsgBox "시트 이름 변경이 완료되었습니다.", vbInformation
End Sub
그리고 이제는 말하면 입 아픈 위 단계를 다시 반복하면 시트 이름이 아래와 같이 변경되었습니다.
촤라란 만족스러운 결과. 단 5분이면 ChatGPT와 할 수 있습니다. (무한 복붙을 했던 나 자신 반성하자… )
텍스트 데이터 정리해서 엑셀로 표 만들기 - 지피터스 GPTers: 한 줄에 여러 데이터 값을 포함하는 텍스트를 VBA 로직을 사용하여 정리하고, 이 데이터로 막대그래프를 그리는 과정을 설명합니다.
ChatGPT API 없이 엑셀 반복 업무 자동화하기 (feat. Apps script): Excel VBA와 비슷한 Google Apps script를 사용하여 엑셀 반복 업무를 자동화하는 방법을 소개합니다.
함께 읽으면 좋은 글