VBS 로 Excel Macro (Sub) 실행하기. Excel 백그라운드 매크로 실행

엑셀을 실행하지 않고 (백그라운드에서 실행하여) 매크로를 실행해주는 방법입니다.
VBS 를 사용합니다. (Visual Basic Script)

새 텍스트 파일을 만들어 확장자를 .vbs 로 변경해주시고 아래의 코드를 붙여넣어보세요.
엑셀 파일은 .xlsm 으로 미리 모듈 등으로 Sub문 매크로를 만들어두셔야 합니다.
VBS 파일의 경로는 xlsm과 같은 경로에 만듭니다.

이걸로 엑셀을 실행해서 작업을 하지 않아 더 빠르게 작업을 해둘 수 있어요.
적당히 응용해서 사용해보세요.

Dim Excel, Path

Set Excel = WScript.createObject("Excel.Application")

Path = WScript.ScriptFullName             ' 현재 실행하는 전체 파일이름 (경로+이름)
Path = Left(Path, InStrRev(Path, "\"))  ' 이름제거후 경로만 추출

Excel.Workbooks.Open(Path&"엑셀파일이름.xlsm") '매크로 포함된 엑셀 파일 실행

'실행하고 싶은 Sub문 입력
'Sub문에 모든걸 해두고 그 함수를 호출하는 것이 순차적으로 처리되어 원하는 결과물이 나올 것입니다.
'순차적으로 Excel.Run 을 시키면 동시에 실행되서 이상한 결과가 나올 수 있어요.
'이 함수에서 처리가 끝난 후, 해당 Workbook 을 저장하기를 권합니다.
Excel.Run "Sub문 매크로 함수명" 

' 파일 닫기
Excel.Quit

'변수 초기화
Set Excel = Nothing
Set Path = Nothing

Excel VBA 엑셀 파일 경로 값 가져오기 File Location

엑셀 파일 경로 값 가져오기

Function getCellValue(LOC_, strFile , strSheet , strPath )
'파일을 여는 것 따로 해줘야 하는데, 열었다 닫았다 prcess 과부하가 걸릴 수 있으므로 주의

    Dim strPath, strFile, strSheet, strRng, strRef, Result As String

    strPath = PathName_ 
    strFile = FileName_
    strSheet = SheetName_
    'strRng = Range(LOC_).Value
    strRng = LOC_

    strRef = "'" & strPath & "[" & strFile & "]" & strSheet & "'!" & strRng
    'Debug.Print (strRef)
    getCellValue = Range(strRef).Value
End Function

끝.

Excel Vba Sheet 내용을 Text 파일로 저장하기 (UTF-8)

시트의 내용을 텍스트 파일로 저장하기. (UTF-8 대응)

Sub SheetToText()

    Dim streamWrite As New ADODB.Stream '// 쓰기 스트림 선언 Microsoft ADODB 6.1 (ActiveX) 참조 필수
    Dim sText       As Variant          '// 파일 데이터 선언

    
    '// 파일 쓰기
    streamWrite.Type = adTypeText
    streamWrite.Charset = "UTF-8"
    streamWrite.Open
    
    '// 첫줄에 넣을 메시지
    streamWrite.WriteText "// 첫줄"
    
    '//시트 데이터 읽는데 필요한 변수 선언
    Dim rng As Range
    Dim iRow As Long, iCol As Integer
    Dim sTxt As String, sPath As String, deLimiter As String
    Set rng = ActiveSheet.UsedRange

    deLimiter = ", "     '// 구분자 "," 입력 바꿔도 됨

    For iRow = 1 To rng.Rows.Count  '// 1행부터 마지막 행까지
        For iCol = 1 To rng.Columns.Count  '// 1열부터 오른쪽 최대 열까지
            sTxt = sTxt & ActiveSheet.Cells(iRow, iCol).Value & deLimiter
        Next iCol
        streamWrite.WriteText (Left(sTxt, Len(sTxt) - 1) & vbLf)

       sTxt = vbNullString
    Next iRow
    
    
    '// 스트림의 마지막 표시
    streamWrite.SetEOS
    
    '// 세이브
    Call streamWrite.SaveToFile(Application.ActiveWorkbook.Path + "\" + ActiveSheet.Name + ".txt", adSaveCreateOverWrite) '//저장할 경로와 파일 이름은 필요에 따라 변경할 것
    
    '// 스트림 클로즈
    streamWrite.Close
    
End Sub

EXCEL VBA로 euc-kr -> utf-8로 변경하는 코드

EXCEL VBA로 텍스트 쓸 때 이미 써진 파일을 euc-kr -> utf-8 로 수정하는 코드

'Microsoft ActiveX Data Objects 6.1 Library 참조 필요

Private Sub EuckrToUtf8NoBOM(a_sFrom, a_sTo)

    Dim streamRead  As New ADODB.Stream '// 읽을 데이터
    Dim streamWrite As New ADODB.Stream '// 작성할 데이터
    Dim sText       As Variant          '// 파일 데이터
    
    '// 파일데이터
    streamRead.Type = adTypeText
    streamRead.Charset = "euc-kr" '여기에 한글형을 입력한다.
    streamRead.Open
    Call streamRead.LoadFromFile(a_sFrom)
    
    '// 개행코드 CRLF를 LF로 변환
    sText = streamRead.ReadText
    sText = Replace(sText, vbCrLf, vbLf)
    
    '// 파일쓰기
    streamWrite.Type = adTypeText
    streamWrite.Charset = "UTF-8"
    streamWrite.Open
    
    '// euc-kr 을 utf-8 데이터로 쓴다.
    Call streamWrite.WriteText(sText)
    
    '// 바이너리 모드로 쓴 데이터 시작 위치를 BOM분의 3바이트씩 민다.
    streamWrite.Position = 0
    streamWrite.Type = adTypeBinary
    streamWrite.Position = 3
    
    '// 3바이트 민 상태에서 데이터를 취득
    sText = streamWrite.Read
    
    '// 3바이트 민 위치를 원래대로 돌린다.
    streamWrite.Position = 0
    
    '// BOM이 제거된 데이터를 처음부터 다시 쓴다.
    Call streamWrite.Write(sText)
    
    '// 현시점의 말미를 끝으로, 직전에 쓴 3바이트를 데이터 대상외로 한다.
    streamWrite.SetEOS
    
    '// 저장
    Call streamWrite.SaveToFile(a_sTo, adSaveCreateOverWrite)
    
    '// 파일 닫기
    streamRead.Close
    streamWrite.Close
End Sub

EXCEL VBA 텍스트 파일 저장하기 (출력하기)

data 코드의 일부를 자동 생성해주는 스크립트 만들 때 유용하다.

Option Explicit

Sub Createtextfile()


Dim TF As Object
Dim TFT As Object

'만들기
Set TF = CreateObject("scripting.filesystemobject")
Set TFT = TF.Createtextfile(Application.ActiveWorkbook.Path + "\l10n.js")

'Debug.Print (Application.ActiveWorkbook.Path)

'내용넣기
TFT.WriteLine "this is just test file" & vbCr & "afs"
TFT.WriteLine "this is 2nd line of test file"
TFT.WriteLine ActiveSheet.Name

'닫기
TFT.Close
Set TF = Nothing
Set TFT = Nothing

End Sub

Excel 모든 시트 셀 내용만 지우기

아래의 스크립트를실행한다.

Sub 모든시트내용지우기()

         Dim WS_Count As Integer
         Dim i As Integer

         WS_Count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For i = 1 To WS_Count

            ' 여기에 원하는 코드를 넣는다. 열린 파일에 숨긴 시트가 있으면 에러날 때가 있음
            Debug.Print ("시트 변경함 : " + ActiveWorkbook.Worksheets(i).name)
            ActiveWorkbook.Worksheets(i).Select 
            Cells(1, 1).Select
            
            '모든 셀 내용 삭제
            Cells.Select
            Selection.ClearContents

         Next i

End Sub

Excel 파일 Compare 하기

COM 추가기능에 Inquire 를 추가하면 Excel 파일을 비교하는 기능을 사용할 수 있다.

Inquire 추가 방법

Excel 에서 JSON 파싱하기 (VBA사용, excel 365에서 확인 완료)

좋은 방법이 있을까 고민하다가 선구자를 따라가기로 했다.
github에 괜찮은 도구가 있어서 이것을 소개한다.

해당 git에서 "JsonConverter.bas" 파일을 VBA 프로젝트로 가져오기 (Import) 하면 끝
JsonConverter 라는 module 이 추가된다.
(vb6.0 에서 microsoft scripting runtime 참조 체크 해두어야 했던것 같음)

Windows Only, Mac용에서 사용하려면 추가 라이브러리의 설치가 필요한데 이건 안해봤음.(현재 Mac이 없음)

사용 방법 샘플 코드

Private Sub VBA_JSON_TEST()
Dim JSON_ As String
Dim Parse As Object

'json 소스
    JSON_ = "{  ""data"": {    ""translations"": [      {        ""translatedText"": ""welcome."",        ""detectedSourceLanguage"": ""ko""      }    ]  }}"
    Set Parse = JSONConverter.ParseJson(JSON_)

    '접근 방법
    Debug.Print Parse("data")("translations")(1)("translatedText")

End Sub

https://github.com/VBA-tools/VBA-JSON

Excel 어떤 단어가 몇개 포함하고 있는지 계산하는 방법

정규식으로 하려다가 엑셀 기능 가지고 해보게 된 일이 있는데...

어떤 단어가 1개 이상 포함된 경우 이것이 몇개 포함되었는지 확인하는 계산식이다.

만일 G2라는 셀에 "abc(VALUE)ab(VALUE)abcd(VALUE)eee"라는 값이 있는데 여기에는 (VALUE)라는 단어가 3개 존재하고 있다. 이게 3개가 있음을 확인하는 방법이다.

1. 일단 G2의 전체 길이를 알아낸다.
2. (VALUE)를 모두 제거한 값의 길이를 알아낸다.
3. (VALUE)는 7글자이므로 1에서 2를 뺀 뒤, 7로 나눈 값이 포함된 갯수를 의미한다.

엑셀 수식으로 하면 이렇게 된다.

=(LEN(G2)-LEN(SUBSTITUTE(G2,"(VALUE)","")))/LEN("(VALUE)")

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

엑셀 수식 -> 텍스트, 텍스트 -> 수식 팁

엑셀 수식을 텍스트로 만들 때는 함수로 간단히 된다.

=FORMULATEXT()

반대의 경우는 준비된 함수가 없기 때문에

모듈을 새로 추가하여 아래와 같이 커스텀 함수를 만들어 준다.

Function Eval(Ref As String)

Application.Volatile

Eval = Evaluate(Ref)

End Function

추가 한 후 아래커스텀 함수를 사용하면 된다.

=Eval()

EXCEL VBA 에서 Http Request 하는 방법

VBA 도구를 만들다가 외부 API 와 통신할 일이 있어서 남기는 기록이다.
보통 Open API 를 이용하면 JSON 으로 리턴되므로 이걸 파싱해서 쓰면 된다.

아래코드를 실행 하기 전에, 참조를 추가해야 한다.

Visual Basic 도구, 참조 메뉴에서
Microsoft WinHTTP Services, version 5.1 이 사용하도록 체크되어 있어야 한다.



참고 소스 코드

Function requestHTTP()

Dim PostData As String
Dim T As String

'Web에서 가져오기, 에러 발생하면 참조모듈 확인 (Microsoft WinHttpRequest 가 참조되어야 함)
Dim httpRequest As New WinHttpRequest

'아래에 넘길 포스트 데이터를 적는다.
    PostData = "postData=_postData" 
    
        With httpRequest
        .Open "POST", "http://오픈할 Open API 주소"
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
        .Send PostData
        .WaitForResponse: DoEvents
        T = .ResponseText
        
    End With

requestHTTP = T
    
End Function

인공지능 번역기 툴을 만들다가 남기는 후기

어플리케이션의 스트링 리소스를 한방에 (기계)번역하는 툴을 필요에 의해서 만들게 되었다.
(복붙이 너무 귀찮았어...)

구글 API 는 유료이길래 별 생각 없이 라이벌(?) 이라고 불리는 네이버 PAPAGO Open API 로 번역을 해봤다.

하루종일 삽질해서 Unity 용 툴, 엑셀용 VBA 툴 2가지를 만들었는데... (VBA가 더 어렵네 -_-;; )

막상 PAPAGO 의 번역 품질을 보니 쓰기 어려운 수준이라는 느낌을 받았다.
아래의 번역 시험 결과는 아주 소프트한 예시이다. (그나마 잘된걸 고른 것)

실제로 특수기호나 숫자가 섞이거나, 외래어 표기가 된 한글의 처리가 제대로 되지 않아서 쓰기 힘들었다.
예를 들면 "웹캠" 이라는 단어가 있으면 구글은 Web Cam 으로 PAPAGO는 "웹캠"으로 번역해버린다. (한글로 그대로 출력)

Oh My God.

뭐 가끔 쓰는 정도로 하는걸로 하고 오늘의 작업을 마무리..

Unity 툴은 에셋 스토어에 올려버렸고,

VBA 는 좀 더 다듬어서 블로그에 공개해야겠다.
누군가라도 쓰겠지 랄까 -_-;;;;

- [번역 시험 결과]----------------------------------------------

Source)
장치가 사용 중이거나 응답하지 않습니다.
영상 요청을 중단합니다.
다른 장치로 다시 시도해봐주세요.

Google)
The device is busy or not responding.
Abort video requests.
Please try again with another device.

Papago)
Device is busy or unresponsive.
Stops image request.
Try again with another device.