VBA, 자주쓰는 코드

자주쓰는 코드

'작업속도 상승
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With

'작업속도 복구
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With

'시트잠금/해제
Application.ScreenUpdating = False
Sheet1.Protect Password:="1234"
Sheet1.Unprotect Password:="1234"
Application.ScreenUpdating = True

'파일명 가져오기
folderPath = Application.ActiveWorkbook.Path   
myPath = Application.ActiveWorkbook.FullName
Worksheets.Count '시트의 갯수를 의미합니다.
Worksheets(1) '시트탭에 있는 시트중 첫번째(1) 시트를 의미합니다

'시트복사
Worksheets("Sheet1").Copy before:=Worksheets("Sheet1")

'시트 이름 유무 확인하기
Function WS_exists(name)
    WS_exists = False
    For Each ws In ActiveWorkbook.Worksheets
        If ws.name = name Then WS_exists = True
    Next ws
End Function

배열

dim 정적배열(행의크기, 열의크기) as 데이터형

dim 동적배열() as 데이터형
redim preserve 동적배열(행의크기, 열의크기)
 'preserve를 사용하지 않으면 배열의 값이 0으로 초기화됨

'---현재 시트의 모든 개체 삭제
ActiveSheet.DrawingObjects.Delete

'---문자열 내에서 검색
Dim SearchWithinThis As String = "ABCDEFGHIJKLMNOP"
Dim SearchForThis As String = "DEF"
Dim FirstCharacter As Integer = SearchWithinThis.IndexOf(SearchForThis)

'---문자열 찾기
Val = InStr("ab", "b")

'---파일명 가져오기
fN = Application.ActiveWorkbook.FullName
MsgBox Mid(fN, InStr(fN, "문자열") + 5, Len(fN) - InStr(fN, "문자열") - 9)


'---PDF파일로 저장하기
fName = ThisWorkbook.Path & "Name.pdf"
Range("A1:B2").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName, _
quality:=xlQualityStandard, IncludeDocProperties:=True, ignoreprintareas:=False, openafterpublish:=True

파일 열고 필요한 부분 복사

Sub fileOpenCopyPasteClose()
    '열고
    Workbooks.Open "c:\practice\hello.xlsx"
    '카피하고
    Workbooks("hello.xlsx").Sheets("Sheet1").Range("a1:c100").Copy
    '붙혀넣고
    Workbooks("열고_카피하고_붙여넣고_닫고.xlsm").Sheets("Sheet1").Range("a1").PasteSpecial
    '닫고
    Workbooks("hello.xlsx").Close
End Sub

[모듈] 엑셀파일간 데이터 불러오기

Sub 불러오기_()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

    Dim 연결 As New ADODB.Connection
    Dim 레코드셋 As New ADODB.Recordset
    Dim OLEDB접속 As String
    Dim 경로 As String '경로 = ThisWorkbook.Path & "\"
    Dim 메시지 As String
    Dim 시트 As Worksheet
    Dim 이름정의 As String
    Dim 붙여넣을시작셀 As Range

    '---------------------  [ 파일 경로 ] ------------------------
    경로 = "~/ab.xlsb"

    '---------------------  [ 초기값 셋팅 ] ------------------------
    Set 시트 = Sheets("RD")                '현재파일 적용시트
    Set 붙여넣을시작셀 = Range("A4")      '현재파일 적용시트 실제 데이터의 윗행

    이름정의 = "RD"                 '원본소스 파일의 이름관리자
    '------------------------------------------------------------------
    OLEDB접속 = "Provider=Microsoft.Ace.OLEDB.12.0;" & _
                "Data Source='" & 경로 & "';" & _
                "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"

    연결.Open OLEDB접속
    '----------이름 정의 수정
    레코드셋.Open Source:="[" & 이름정의 & "]", _
                  ActiveConnection:=연결, _
                  CursorType:=adOpenStatic, _
                  LockType:=adLockReadOnly, _
                  Options:=adCmdTable

    메시지 = "테이블에 연결되었습니다." & vbCr
    메시지 = 메시지 & "총 " & 레코드셋.RecordCount & "건의 데이터가 있습니다." & vbCr & vbCr
    메시지 = 메시지 & "가져올까요?"

    If MsgBox(메시지, vbYesNo) = vbYes Then
    '----------붙여넣을 위치 (한줄 여백)
        With 시트.QueryTables.Add(Connection:=레코드셋, Destination:=붙여넣을시작셀)
            '.Name = "외부데이터"
            .RefreshStyle = xlOverwriteCells
            .Refresh
        End With
    End If
    레코드셋.Close
    연결.Close
    '------------------------------------------------------------------
    Range(Range("A1"), Range("SS1").End(xlToLeft)).ColumnWidth = 11 '열너비
    Range(붙여넣을시작셀.Row + 1 & ":" & Range("B100000").End(xlUp).Row).RowHeight = 20 '행높이
    붙여넣을시작셀.EntireRow.ClearContents '첫행 내용삭제
    '------------------------------------------------------------------
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

정보입력 - 한줄 삽입

Dim Rng As Range
Dim 신규 As Range
Dim i As Integer

Set Rng = Range("E:E").Find(what:=Right(항목선택(Frame_Site), 2))
Set 신규 = Range("B:B").Find(what:="신규")

i = Rng.End(xlDown).Offset(1).Row

Rng.End(xlDown).Offset(1).EntireRow.Insert , copyorigin:=xlFormatFromLeftOrAbove
신규.EntireRow.Copy
Rng.End(xlDown).Offset(1, -4).Select
ActiveSheet.Paste

Cells(i, "B") = Cells(i - 1, "B").Value + 1
Cells(i, "C") = 항목선택(Frame_Ing)
Cells(i, "D") = 항목선택(Frame_Charge)
Cells(i, "E") = Right(항목선택(Frame_Site), 2)
Cells(i, "F") = 항목선택(Frame_Inst)
Call 옵션선택(Frame_Option, i)

Cells(i, "I") = TextBox1.Value
Cells(i, "J") = TextBox2.Value
Cells(i, "O") = TextBox3.Value

'텍스트박스 리셋
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""

'셀 선택 초점변경
Rng.End(xlDown).Offset(0, 4).Select

특정파일 값 가져오기

Sub 매크로1()
' 매크로1 매크로
Dim fLink As String
fLink = "경로"

Dim eFile as Workbook
set eFile = GetObject(fLink)

Dim eRow As Integer
eRow = eFile.Sheets(1).Range("A10000").End(xlUp).Row

Dim val
val = eFile.Sheets(1).Range("A3:E" & eRow)

Dim Rng As Range
Set Rng = eFile.sheets(1).Range("A3:E7")
Rng.Copy

sheet1.Range("A3").PasteSpecial xlPasteVales

'다 사용한 객체는 꼭 닫아주기
eFile.Close

Find, Find Next

https://simon-k.tistory.com/16

x