Excel 매크로 (VB) 샘플

Sub 링크추출()
On Error Resume Next
Dim rngCell As Range
Dim lnkLink As Hyperlink

For Each lnkLink In ActiveSheet.Hyperlinks
With lnkLink.Parent
.Offset(0, 1) = .Hyperlinks.Item(1).Address
End With
Next lnkLink
End Sub

-----------------------------------------
My) 내가 짠 매크로

Sub 매출손익추출_Click()

Dim str As String
Dim i1 As Integer
i1 = 0

Loop1:
str = ActiveCell.Value
If str = "" Then
  Exit Sub
End If

'테스트용. 5회반복후 탈출
'  i1 = i1 + 1
'  If i1 > 5 Then
'    Exit Sub
'  End If


With ActiveCell  '시트명 찾아서 특정셀의 값 추출
   .Offset(0, 5) = Worksheets(str).Range("i33").Value
   .Offset(0, 6) = Worksheets(str).Range("j33").Value
   .Offset(0, 7) = Worksheets(str).Range("i32").Value
   .Offset(0, 8) = Worksheets(str).Range("j32").Value
End With
 
' 아래줄로 이동
ActiveCell.Offset(1, 0).Select
 
GoTo Loop1

End Sub

-----------------------------------------------

셀에 있는 시트명을 삭제하는 매크로

Sub Sheet삭제()
'준비조건: 커서를 회사명의 셀에 두어야 함.
'커서가 빈칸으로 이동하면 매크로는 멈춤.

Dim str As String
Dim i1 As Integer
i1 = 0

On Error Resume Next

Loop1:
str = ActiveCell.Value
If str = "" Then
  Exit Sub
End If

'테스트용. 5회반복후 탈출
'  i1 = i1 + 1
'  If i1 > 5 Then
'    Exit Sub
'  End If

Worksheets(str).Delete
 
' 아래줄로 이동
ActiveCell.Offset(1, 0).Select
 
GoTo Loop1

End Sub-----------------------------------------

Function 시트명추출(Optional 시작 As Integer, Optional 길이 As Integer = 0)
  Application.Volatile 

  If 시작 < 0 Or 길이 < 0 Then
    시트명추출 = "#인수값 확인!"
    Exit Function
  End If
  If 시작 = 0 Then 시작 = 1
  If 길이 = 0 Then
    시트명추출 = Mid(Application.Caller.Parent.Name, 시작)
  Else
    시트명추출 = Mid(Application.Caller.Parent.Name, 시작, 길이)
  End If
End Function


-----------------------------------------


7. shee1시트의 a1셀에 12를 입력
   worksheets("sheet1").range("a1").value=12
  
-----------------------------------------

7. with구문
   with 반복되는 명령
.속성값1
.속성값2
   end with
   '예) with activecell
   .offset(0,0)="1"
   .offset(0,1)="2"
   .offset(0,2)="3"
end with

'예를 한줄로 표현
activecell.resize(,3)=array("1","2","3")  


-----------------------------------------

activecell.value = "1"


-----------------------------------------
'에러 처리

Sub err_Resume()
On Error GoTo ErrHandler
Workbooks.Open "C:\없는파일이름.xlsx"
Exit Sub
ErrHandler:
If Err <> 0 Then           '에러가 발생했으면
    Resume                  '에러난 행을 재실행
End If

End Sub


Sub err_Resume_Next()
On Error GoTo ErrHandler
Workbooks.Open "C:\없는파일이름.xlsx"
Exit Sub

ErrHandler:
If Err <> 0 Then          '에러가 발생했으면
    Resume Next          '에러난 다음 행을 실행
End If

End Sub