VBA Function
자주쓰는 코드
'작업속도 상승
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
'마지막시트에 시트추가
Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)).name = "테스트"
배열
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
구조 - 표시기능 (도형/시트)
'개체 표시
Sheet1.CommandButton1.Visible = False
Sheet1.CommandButton1.Visible = True
Sheet1.Shapes("Button_1").Visible = msoFalse
Sheet1.Shapes("Button_1").Visible = msoTrue
'시트 숨김
Worksheets("시트명").Visible = xlSheetVeryHidden / true / false
'워크북 잠금
ThisWorkbook.Unprotect Password:=""
'실행 페이지[시트]
Worksheets("시트명").Activate
파일 열어서 필요한 부분 복사해오기
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
1/10 폴더내 모든파일/모든시트 특정영역 바꾸기
https://m.blog.naver.com/rosa0189/60164106532
Option Explicit
Sub replace_All_Data_In_Folder() '메인 프로시저
Dim strPath As String '폴더의 경로를 넣을 변수
Dim fileName As String '각 파일 이름을 넣을 변수
Dim wkBk As Workbook '각 파일을 넣을 변수
Dim wkSht As Worksheet '각 시트를 넣을 변수
Dim rngAll As Range '검색할 영역을 넣을 변수
With Application '엑셀에서
.ScreenUpdating = False '화면 업데이트 (일시) 정지
.Calculation = xlCalculationManual '셀계산 수동으로 전환
With .FileDialog(msoFileDialogFolderPicker) '폴더선택 창에서
.Show '폴더 선택창 띄우기
If .SelectedItems.Count = 0 Then '취소 선택 시
Exit Sub '매크로 종료
Else '파일 존재 시
strPath = .SelectedItems(1) & "\" '폴더 경로를 변수에 넣음
End If
End With
fileName = Dir(strPath & "*.xls*") '(폴더내)각 엑셀파일 이름을 변수에 넣음
If fileName = "" Then '폴더에 파일이 없으면
MsgBox "폴더에 파일이 없습니다." '메시지 출력
Exit Sub '매크로 중단
End If
Do While fileName <> "" '이름이 없지 않다면, 즉, 엑셀파일이 존재하면
Set wkBk = Workbooks.Open(strPath & fileName) '파일을 열고 변수에 넣음
For Each wkSht In wkBk.Worksheets '열린파일 각 시트를 순환
Set rngAll = wkSht.Range("A1:J10") '검색영역을 변수에 넣음
Call replace_Data(rngAll) '바꾸기 코드를 호출
Next wkSht
wkBk.Close True '파일을 저장하고 닫음
fileName = Dir '다음 파일을 파일이름에 넣음
Loop '무한 반복
.Calculation = xlCalculationAutomatic '셀계산 자동으로 복원
End With
Set wkBk = Nothing '개체변수들 초기화(메모리 비우기)
Set rngAll = Nothing
End Sub
Private Sub replace_Data(ByVal rngAll As Range) '검색일치한 값을 바꾸는 하위 프로시저
Dim strAddr As String '처음 검색하여 찾은 셀의 주소 넣을 변수
Dim C As Range '검색하여 찾은 영역을 넣을 변수
With rngAll '검색할 영역에서
Set C = .Find(What:="갑", Lookat:=xlWhole) '처음 모두 일치하는 데이터를 찾아 C에 넣고
If Not C Is Nothing Then '만일 일치하는 데이터가 있으면
strAddr = C.Address '첫 일치하는 주소를 strAddr에 넣고
Do '다음을 실행
C.Interior.ColorIndex = 6 '셀의 색을 노란색으로
C = "ZZZ" '검색 일치한 셀에 바꾸려는 값 입력
Set C = .FindNext(C) '다음 일치하는 데이터를 찾아 변수에 넣고
Loop While Not C Is Nothing
End If '일치하는 데이터 없을 때까지 반복
End With
Set C = Nothing '개체변수 초기화(메모리 비우기)
End Sub
특정파일 값 가져오기
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
Template
Sub SheetUnit()
Dim i As Integer
Dim ShtA As Worksheet
Dim rngB As Range
Set ShtA = Sheets(1)
For i = 2 To Sheets.Count
Set rngB = ShtA.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Sheets(i).UsedRange.Copy rngB
Next i
End Sub
Sub Macro()
Dim 폴더 As String, 파일 As String, wb As Workbook
폴더 = ThisWorkbook.Path & "\"
파일 = Dir$(폴더 & "*.xls?")
On Error Resume Next ' 시트가 없어서 에러 나더라도 넘어가기
Do Until 파일 = ""
If 파일 <> ThisWorkbook.Name Then ' 이 파일이 아니면
Set wb = Workbooks.Open(폴더 & 파일)
wb.Sheets("a").Name = "가" ' a시트를 가로 바꾸기
wb.Sheets("b").Name = "나" ' b시트를 나로 바꾸기
wb.Sheets("c").Name = "다" ' c시트를 다로 바꾸기
wb.Close True ' 파일 저장후 닫기
Set wb = Nothing ' 워크북 변수 초기화
End If
파일 = Dir$ ' 다음파일
Loop
End Sub
Option Explicit
Sub 파일순환_현재폴더_다중선택()
Dim wb As Workbook
Dim shtC As Worksheet
Dim strName As String
Dim vatC As Variant
Dim vatFiles As Variant
Dim r As Range
vatFiles = Application.GetOpenFilename(filefilter:="엑셀 파일(*.xls),*.xls,엑셀 파일(*.xlsx),*.xlsx", _
Title:="통합파일 선택", MultiSelect:=True)
Application.ScreenUpdating = False
If TypeName(vatFiles) <> "Boolean" Then '취소를 누르지 않았다면 작업을 실행한다.
For Each vatC In vatFiles
'순환되는 파일의 업데이트 표시를 안나오게 하면서 읽기모드로 연다
Set wb = Workbooks.Open(fileName:=vatC, UpdateLinks:=2, ReadOnly:=True)
For Each shtC In wb.Worksheets '시트를 순환한다.
Set r = shtC.UsedRange
If r.Cells.Count > 1 Then
strName = Left(wb.Name, InStrRev(wb.Name, ".") - 1) & "_" & shtC.Name
ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = strName
r.Copy ThisWorkbook.Worksheets(strName).Range("A1").Resize(r.Rows.Count, r.Columns.Count)
End If
Next shtC
wb.Close False '파일을 닫는다.
Set wb = Nothing '개체메모리를 해제한다.
Next vatC
Else
MsgBox "취소를 하였습니다."
Exit Sub
End If
MsgBox "선택된 파일을 모두 통합하였습니다.", vbInformation, "작업 완료 알림"
Application.ScreenUpdating = True
End Sub
'개체변수 Object 변수
'엑셀 VBA를 사용하다 보면 범위, 워크시트 등을 변수로 지정해야 하는 상황이 옵니다. 예를 들어 개체의 위치 Workbook("예제1).Worksheets("예제1").range("A1") 를 변수 a라고 지정하고 Object로 선언하게 되면, a.value 는 workbook("예제1").worksheets("예제1").range("A1").value과 같은 값을 갖게 됩니다. 코드가 어느정도 복잡해 지면 로딩시 속도가 현저히 느려지게 되는데, Object 변수를 잘 활용하면 속도 저하를 방지할 수 있습니다.
Find, Find Next
https://simon-k.tistory.com/16
Filter
https://www.excelcampus.com/vba/macros-filters-autofilter-method/
일괄주석처리
Vba Key Codes
Key Codes
Constant Value Description
vbKeyLButton 1 Left mouse button
vbKeyRButton 2 Right mouse button
vbKeyCancel 3 CANCEL key
vbKeyMButton 4 Middle mouse button
vbKeyBack 8 BACKSPACE key
vbKeyTab 9 TAB key
vbKeyClear 12 CLEAR key
vbKeyReturn 13 ENTER key
vbKeyShift 16 SHIFT key
vbKeyControl 17 CTRL key
vbKeyMenu 18 MENU key
vbKeyPause 19 PAUSE key
vbKeyCapital 20 CAPS LOCK key
vbKeyEscape 27 ESC key
vbKeySpace 32 SPACEBAR key
vbKeyPageUp 33 PAGE UP key
vbKeyPageDown 34 PAGE DOWN key
vbKeyEnd 35 END key
vbKeyHome 36 HOME key
vbKeyLeft 37 LEFT ARROW key
vbKeyUp 38 UP ARROW key
vbKeyRight 39 RIGHT ARROW key
vbKeyDown 40 DOWN ARROW key
vbKeySelect 41 SELECT key
vbKeyPrint 42 PRINT SCREEN key
vbKeyExecute 43 EXECUTE key
vbKeySnapshot 44 SNAPSHOT key
vbKeyInsert 45 INS key
vbKeyDelete 46 DEL key
vbKeyHelp 47 HELP key
vbKeyNumlock 144 NUM LOCK key
KeyA Through KeyZ Are the Same as Their ASCII Equivalents: 'A' Through 'Z'
Constant Value Description
vbKeyA 65 A key
vbKeyB 66 B key
vbKeyC 67 C key
vbKeyD 68 D key
vbKeyE 69 E key
vbKeyF 70 F key
vbKeyG 71 G key
vbKeyH 72 H key
vbKeyI 73 I key
vbKeyJ 74 J key
vbKeyK 75 K key
vbKeyL 76 L key
vbKeyM 77 M key
vbKeyN 78 N key
vbKeyO 79 O key
vbKeyP 80 P key
vbKeyQ 81 Q key
vbKeyR 82 R key
vbKeyS 83 S key
vbKeyT 84 T key
vbKeyU 85 U key
vbKeyV 86 V key
vbKeyW 87 W key
vbKeyX 88 X key
vbKeyY 89 Y key
vbKeyZ 90 Z key
Key0 Through Key9 Are the Same as Their ASCII Equivalents: '0' Through '9
Constant Value Description
vbKey0 48 0 key
vbKey1 49 1 key
vbKey2 50 2 key
vbKey3 51 3 key
vbKey4 52 4 key
vbKey5 53 5 key
vbKey6 54 6 key
vbKey7 55 7 key
vbKey8 56 8 key
vbKey9 57 9 key
Keys on the Numeric Keypad
Constant Value Description
vbKeyNumpad0 96 0 key
vbKeyNumpad1 97 1 key
vbKeyNumpad2 98 2 key
vbKeyNumpad3 99 3 key
vbKeyNumpad4 100 4 key
vbKeyNumpad5 101 5 key
vbKeyNumpad6 102 6 key
vbKeyNumpad7 103 7 key
vbKeyNumpad8 104 8 key
vbKeyNumpad9 105 9 key
vbKeyMultiply 106 MULTIPLICATION SIGN (*) key
vbKeyAdd 107 PLUS SIGN (+) key
vbKeySeparator 108 ENTER (keypad) key
vbKeySubtract 109 MINUS SIGN (-) key
vbKeyDecimal 110 DECIMAL POINT(.) key
vbKeyDivide 111 DIVISION SIGN (/) key
Function Keys
Constant Value Description
vbKeyF1 112 F1 key
vbKeyF2 113 F2 key
vbKeyF3 114 F3 key
vbKeyF4 115 F4 key
vbKeyF5 116 F5 key
vbKeyF6 117 F6 key
vbKeyF7 118 F7 key
vbKeyF8 119 F8 key
vbKeyF9 120 F9 key
vbKeyF10 121 F10 key
vbKeyF11 122 F11 key
vbKeyF12 123 F12 key
vbKeyF13 124 F13 key
vbKeyF14 125 F14 key
vbKeyF15 126 F15 key
vbKeyF16 127 F16 key
IP주소 가져오기
Private Const WMISql As String = "SELECT IPAddress, IPSubnet, DefaultIPGateway FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True "
Private Function GetLocalIPaddress() As String
Dim myWMI As Object
Dim myItms As Object
Dim myItm As Object
Set myWMI = GetObject("winmgmts:\\" & Environ("ComputerName") & "\root\CIMV2")
Set myItms = myWMI.ExecQuery(WMISql, , 48)
For Each myItm In myItms
GetLocalIPaddress = myItm.IPAddress(0)
Next
Set myWMI = Nothing
Set myItms = Nothing
Set myItm = Nothing
End Function
Sub main()
Dim str_Local_IP As String
str_Local_IP = GetLocalIPaddress
MsgBox str_Local_IP
End Sub
Module
'----------------------
' Unmerge
'----------------------
Function 셀병합해제(범위 As range)
Call 속도향상
For Each Rng In 범위
If Rng.MergeCells Then
With Rng.MergeArea
.UnMerge
.Formula = Rng.Formula
End With
End If
Next
Call 속도복구
End Function
'----------------------
' Merge
'----------------------
Function 셀병합(범위 As range)
Call 속도향상
Dim q, rCnt As Long
q = 범위.Column
rCnt = 범위.Rows.Count
For r = (rCnt + 범위.Row - 1) To (2 + 범위.Row - 1) Step -1
If Cells(r, q) = Cells(r - 1, q) And Len(Cells(r, q)) > 1 Then
Union(Cells(r, q), Cells(r - 1, q)).Merge
End If
Next r
Call 속도복구
End Function
VBA 에러처리 (Try / Catch) 링크
Excel
개행문자 제거하기
- [Ctrl + H] [찾기 및 바꾸기]
- 찾을 내용에서 [Ctrl + J] (입력란에는 아무것도 입력안됨)
- 바꿀 내용에서 줄바꿈에서 변경할 문자를 입력 (예: ",", "&", "/" 등)
- 모두 바꾸기
or = SUBSTITUTE (셀, CHAR(10), ",")
타프로그램 실행코드
■ [VBA] 엑셀에서 아래한글, 메모장 등 타 프로그램 실행법
-->Shell 함수를 사용하면 VBA로 다른 프로그램을 실행 시킬 수 있습니다. 다음 코드는 엑셀에서 아래한글을 실행시키는 코드입니다.
Sub ExeHwp1()
Dim x
x = Shell("C:hnchwpw.exe", vbNormalFocus)
AppActivate x
End Sub
보통 아래한글을 열었을 경우 불러오기 대화상자가 Defqult로 표시되는데, 이를 표시하지 않고 빈문서 형태로 보이도록 하려면 실행파일 뒤에 옵션인 ' /Q'를 표시해 주면 됩니다. 이 경우 슬래쉬(/) 앞에는 공백을 둡니다.
Sub ExeHwp2()
Dim x
x = Shell("C:hnchwpw.exe /Q", vbNormalFocus)
AppActivate x
End Sub
Shell 함수를 SendKeys 속성과 함께 사용하면 VBA가 지원되지 않는 프로그램과 제한적 연동이 가능합니다. 다음 프로시져는 현재 시트의 A1:C2 셀 범위의 값을 복사해서 메모장을 실행시킨후, 복사한 값을 붙여넣고 Text.txt란 파일명으로 저장하는 프로시져입니다.
Sub NotePad()
Dim x
x = Shell("C:windowsnotepad.exe", vbNormalFocus)
AppActivate x
Range("A1:C2").Copy
Application.SendKeys "^V", True
Application.SendKeys "%FATest~", True
End Sub
SendKeys 속성에서 ^는 Ctrl 키, %는 Alt 키를 의미합니다
하이퍼링크 추출
Sub 하이퍼링크추출()
Dim hLink As Hyperlink
For Each hLink In ActiveSheet.Hyperlinks
With hLink.Parent
.Offset(0, 1) = .Hyperlinks.Item(1).Address
End With
Next hLink
End Sub
DPI 해상도 문제 해결
Option Explicit
'Function to get screen resolution
#If VBA7 Then
Private Declare PtrSafe Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As LongPtr) As Long
'Functions to get DPI
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hDC As LongPtr) As Long
#Else
Private Declare Function GetSystemMetrics32 Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
'Functions to get DPI
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
#End If
Private Const LOGPIXELSX = 88 'Pixels/inch in X
Private Const POINTS_PER_INCH As Long = 72 'A point is defined as 1/72 inches
'Return DPI
Public Function PointsPerPixel() As Double
'hDC LongPtr if VBA7
Dim hDC As Long
Dim lDotsPerInch As Long
hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC
End Function
Private Sub UserForm_Initialize()
Dim w As Long, h As Long
w = GetSystemMetrics32(0) ' Screen Resolution width in points
h = GetSystemMetrics32(1) ' Screen Resolution height in points
With Me
.StartUpPosition = 2
.Width = w * PointsPerPixel * 0.5 'Userform width= Width in Resolution * DPI * 50%
.Height = h * PointsPerPixel * 0.5 'Userform height= Height in Resolution * DPI * 50%
End With
End Sub
'-------------------------------------------
' 문 자 변 환 (Column) **
'-------------------------------------------
Function wColNm(ColNum)
wColNm = Split(Cells(1, ColNum).Address, "$")(1)
End Function
엑셀 VBA 속도 개선
https://m.blog.naver.com/joeclub/220811558178
Access 레코드셋 관련
http://yhkimm.egloos.com/v/367350
history
# 값만 복사하는 코드
Dim rng As Range
Set rng = Worksheets("Sheet1").Range("A1:Z100")
Worksheets("Sheet2").Range("A1").Resize(rng.Rows.Count, rng.Columns.Count).Cells.Value = rng.Cells.Value
20220115
데이터 타입 확인하는 함수
MsgBox TypeName(i)
'--- '표기 제거
Range("C11:" & 마지막열 & 최대값).Replace what:="'", replacement:="", lookat:=xlPart
# 텍스트 줄바꿈 / 셀맞춤
Sht.Range("B10:D100").WrapText = False
Sht.Range("B10:D100").ShrinkToFit = True
https://m.blog.naver.com/PostView.naver?isHttpsRedirect=true&blogId=s5487&logNo=220386926092