3주간 ‘공여사들의 엑셀 혁명 with 챗GPT’ 챌린저스 완주 후기!

Sub 색깔있는텍스트변경()

    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim pattern As String
    Dim regEx As Object
    Dim matches As Object
    Dim i As Integer

    ' "[주문내역]" 시트를 지정합니다.
    ' Set ws = ThisWorkbook.Sheets("[주문내역]")
    Set ws = ThisWorkbook.Sheets("주문내역")

    ' A열의 데이터 범위를 설정합니다. (데이터가 있는 마지막 행까지)
    Set rng = ws.Range("A1", ws.Cells(Rows.Count, "A").End(xlUp))

    ' 정규 표현식을 사용하여 패턴을 찾기 위해 개체를 생성합니다.
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.IgnoreCase = False ' 대소문자 구분 안 함
    regEx.Global = True      ' 모든 일치 항목 찾기

    ' 찾을 패턴을 정의합니다. ("실속" 또는 "프리미엄" 뒤에 숫자가 오고 "미"로 끝나는 텍스트)
    pattern = "(실속|프리미엄)\d+미"

    ' 패턴을 정규 표현식 개체에 할당합니다.
    regEx.pattern = pattern

    ' 각 셀을 순회하며 패턴을 찾고 색을 변경합니다.
    For Each cell In rng
        ' 셀에 정규 표현식 패턴이 있는지 확인합니다.
        If regEx.Test(cell.Value) Then
            ' 패턴과 일치하는 모든 부분을 찾습니다.
            Set matches = regEx.Execute(cell.Value)

            ' 찾은 각 일치 항목에 대해 글자 색을 빨간색으로 변경합니다.
            For i = 0 To matches.Count - 1
                cell.Characters(Start:=matches(i).FirstIndex + 1, Length:=matches(i).Length).Font.color = RGB(255, 0, 0) ' 빨간색 (RGB: 255, 0, 0)
            Next i
        End If
    Next cell

    ' 사용된 개체를 해제합니다.
    Set matches = Nothing
    Set regEx = Nothing
    Set rng = Nothing
    Set ws = Nothing

    MsgBox "지정된 텍스트의 색상 변경이 완료되었습니다.", vbInformation

End Sub

Sub 부서별데이터통합_수정됨() ' 매크로 이름도 혹시 몰라 바꿨어요

    Dim ws As Worksheet
    Dim ws통합 As Worksheet
    Dim lastRow통합 As Long
    Dim lastRow부서 As Long
    Dim i As Long

    ' 데이터를 통합할 새로운 시트 이름을 정의합니다.
    Const 통합시트이름 As String = "통합 데이터"

    ' "통합 데이터" 시트가 이미 존재하는지 확인하고, 없으면 새로 생성합니다.
    On Error Resume Next ' 오류 발생 시 다음 줄로 넘어갑니다.
    Set ws통합 = ThisWorkbook.Sheets(통합시트이름)
    On Error GoTo 0 ' 오류 처리를 다시 활성화합니다.

    If ws통합 Is Nothing Then
        ' 시트가 없으면 새로 만듭니다.
        Set ws통합 = ThisWorkbook.Sheets.Add
        ws통합.Name = 통합시트이름
    Else
        ' 시트가 있으면 기존 데이터를 모두 지웁니다. (머리글 제외)
        ws통합.Cells.ClearContents
    End If

    ' 첫 번째 시트 (예: 해외사업팀 시트)의 머리글을 복사하여 통합 시트에 붙여넣습니다.
    ' 어떤 시트가 첫 번째 시트가 될지는 실행 시점에 따라 달라질 수 있으므로,
    ' 특정 시트의 머리글을 사용하려면 해당 시트 이름을 정확히 지정해야 합니다.
    ' 여기서는 '해외사업팀' 시트의 머리글을 복사하도록 수정합니다.
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets("해외사업팀")
    On Error GoTo 0

    If Not ws Is Nothing Then
        ws.Range("A1:H1").Copy Destination:=ws통합.Range("A1")
    Else
        ' 만약 지정된 시트가 없으면 사용자에게 알립니다.
        MsgBox "'해외사업팀' 시트를 찾을 수 없습니다. 머리글 복사를 건너뜁니다.", vbExclamation
    End If


    ' 각 시트를 순회하며 데이터를 통합 시트에 복사합니다.
    ' 통합 시트와 코드가 들어있는 시트는 제외합니다.
    For Each ws In ThisWorkbook.Sheets
        ' 매크로 코드가 포함된 시트의 이름을 가져오는 부분에 오류가 있을 수 있어서 이 부분을 좀 더 일반적인 방식으로 수정했습니다.
        ' 대신, 매크로를 실행하는 모듈 이름을 알아야 할 수도 있습니다.
        ' 간단하게 통합 시트 이름만 제외하고 순회하도록 수정했습니다.
        If ws.Name <> 통합시트이름 Then ' 통합 시트만 제외
            ' 해당 시트의 마지막 행을 찾습니다.
            lastRow부서 = ws.Cells(Rows.Count, "A").End(xlUp).Row

            ' 데이터가 2행 이상 있을 경우 (머리글 제외) 데이터를 복사합니다.
            If lastRow부서 >= 2 Then
                ' 통합 시트의 마지막 행을 찾습니다. (새 데이터를 붙여넣을 위치)
                lastRow통합 = ws통합.Cells(Rows.Count, "A").End(xlUp).Row

                ' 해당 시트의 데이터 범위를 복사합니다. (A2부터 H열의 마지막 행까지)
                ws.Range("A2:H" & lastRow부서).Copy

                ' 통합 시트의 마지막 행 바로 아래에 붙여넣습니다.
                ws통합.Range("A" & lastRow통합 + 1).PasteSpecial xlPasteAll ' 모든 서식 포함 붙여넣기
                'ws 통합.Range("A" & lastRow통합 + 1).PasteSpecial xlPasteValues ' 값만 붙여넣기 (서식 제외)

                Application.CutCopyMode = False ' 복사 모드 해제
            End If
        End If
    Next ws

    ' 통합 시트를 활성화하여 결과를 보여줍니다.
    ws통합.Activate

    MsgBox "부서별 데이터 통합이 완료되었습니다.", vbInformation

End Sub