VBA 프로그래밍의 기초

Size: px

Start display at page:

Download "VBA 프로그래밍의 기초"

하균 궉
8 years ago
Views:

4 VBA? VBA. VBA. VBA. 4.x VBA VBA. VBA VBA. VBA,. VBA VBA. VBA., VBA. VBA (,, ). VBA.,. VBA,,. VBA,,,.

5 VBA,,...,. VBA.. VBA.

6 VBA. VBA......

7 . B Sub Macro1() ' ' Macro1 Macro ' pp () ' Range("B2").Select ActiveCell.FormulaR1C1 = " " Range("B2").Select Columns("B:B").EntireColumn.AutoFit With Selection.HorizontalAlignment = xlcenter.verticalalignment = xlcenter.wraptext = False.Orientation = 0.AddIndent = False.IndentLevel = 0.ShrinkToFit = False.ReadingOrder = xlcontext.mergecells = False End With With Selection.Font.Name = "".FontStyle = "".Size = 10.Strikethrough = False.Superscript = False.Subscript = False.OutlineFont = False.Shadow = False.Underline = xlunderlinestylenone.colorindex = xlautomatic End With Selection.Borders(xlDiagonalDown).LineStyle = xlnone Selection.Borders(xlDiagonalUp).LineStyle = xlnone

8 Selection.Borders(xlEdgeLeft).LineStyle = xlnone With Selection.Borders(xlEdgeTop).LineStyle = xldash.weight = xlthin.colorindex = 46 End With With Selection.Borders(xlEdgeBottom).LineStyle = xldouble.weight = xlthick.colorindex = 46 End With Selection.Borders(xlEdgeRight).LineStyle = xlnone With Selection.Interior.ColorIndex = 15.Pattern = xlsolid.patterncolorindex = xlautomatic End With End Sub VBA. VBA. VBA..... VBA. VBA.

9 VBA....

10 Sub Option1() Dim payoff Dim k Dim s Dim p Dim response As Double As Double As Double As Double As String p = 3000 k = payoff = payoff - p response = InputBox(" ",, k) If Len(response) = 0 Then Exit Sub s = CDbl(response) If s > k Then payoff = payoff + s - k End If MsgBox "Payoff is " & payoff End Sub Function VanillaPayoff(iOpt As Integer, s As Double, x As Double) If iopt = 1 Then VanillaPayoff = Max(s - x, 0) ElseIf iopt = -1 Then VanillaPayoff = Max(x - s, 0) End If End Function

11 Sub Option1() Dim payoff Dim k Dim s Dim p Dim response p = 3000 k = payoff = payoff - p As Double As Double As Double As Double As String response = InputBox(" ",, k) If Len(response) = 0 Then Exit Sub s = CDbl(response) If s > k Then payoff = payoff + s - k End If MsgBox "Payoff is " & payoff End Sub

12 Dim Arr1(10) As Double Dim Arr2(5) As Long Dim Arr3(1 To 10) As Double Dim Arr4(2 To 5) As Long Dim Arr5() As Double ReDim Arr5(11) Sub Historical_Volatility() Dim closeprice() As Double Dim yld() As Double Dim i As Long Dim stdev As Double Dim yld_year As Double ReDim closeprice(1 To 11) ReDim yld(2 To 11) closeprice(1) = 969 closeprice(2) = 989 closeprice(3) = 995 closeprice(4) = 957 closeprice(5) = 915 closeprice(6) = 880 closeprice(7) = 858 closeprice(8) = 859 closeprice(9) = 848 closeprice(10) = 836 closeprice(11) = 845

13 For i = LBound(closeprice) + 1 To UBound(closeprice) yld(i) = Log(closeprice(i) / closeprice(i - 1)) Next stdev = Application.WorksheetFunction.stdev(yld()) yld_year = stdev * Sqr(52) Debug.Print Format(stdev, "0.00%") Debug.Print Format(yld_year, "0.00%") End Sub LBound(Arr3) 1 UBound(Arr3) 10 LBound(Arr4) 2 UBound(Arr4) 5,,.

14 Sub demo_comparison_operators1() Debug.Print 1 > 2 'False. Debug.Print 3 < 4 'True. Debug.Print 5 <> 6 'True. End Sub Sub demo_comparison_operators2() Debug.Print "A" > "a" 'False. Debug.Print "A" < "B" 'True. Debug.Print "A" <> "a " 'True. End Sub

15 1.IF THEN ELSE A -21. If A>0 Then A If A>0 Then Then (MsgBox A is greater than zero ) ElseIf A<0 Then.

16 2.SELECT CASE Case 1 To 4, 7 To 9, 11, 13, Is >

18 1.FOR...NEXT Sub Historical_Volatility() Dim closeprice() As Double Dim yld() As Double Dim i As Long Dim stdev As Double Dim yld_year As Double ReDim closeprice(1 To 11) ReDim yld(2 To 11) closeprice(1) = 969 closeprice(2) = 989 closeprice(3) = 995 closeprice(4) = 957 closeprice(5) = 915 closeprice(6) = 880 closeprice(7) = 858 closeprice(8) = 859 closeprice(9) = 848 closeprice(10) = 836 closeprice(11) = 845 For i = LBound(closeprice) + 1 To UBound(closeprice) yld(i) = Log(closeprice(i) / closeprice(i - 1)) Next stdev = Application.WorksheetFunction.stdev(yld()) yld_year = stdev * Sqr(52)

19 Debug.Print Format(stdev, "0.00%") Debug.Print Format(yld_year, "0.00%") End Sub

20 2.FOR EACH IN~NEXT

21 3.DO...LOOP Do While~Loop (True) (False). Do Until~Loop (True). Do~Loop While (True) (False).

22 Do~Loop Until (True). Do~Loop. Do~Loop. Exit Do.

23 StrComp() Sub demostrcomp() Dim MyStr1 As String Dim MyStr2 As String MyStr1 = "ABCD" MyStr2 = "abcd" 'Text, 0 MsgBox StrComp(MyStr1, MyStr2, 1) ', -1 MyStr1 MyStr2. MsgBox StrComp(MyStr1, MyStr2, 0) ' Option Compare. MsgBox StrComp(MyStr1, MyStr2) End Sub

24 StrConv( ) Sub demostrconv() MsgBox StrConv("upper case", vbuppercase) MsgBox StrConv("LOWER CASE", vblowercase) MsgBox StrConv("proper case", vbpropercase) MsgBox StrConv("wide", vbwide) MsgBox StrConv("", vbnarrow) End Sub Len( )

25 If TestStr= Then End If If Len(TestStr)=0 Then End If Sub demolen() MsgBox Len("ABCD") MsgBox Len("AB CD") MsgBox Len("") End Sub Format( )

27 InStr( ) InStr InStr (1, "Tech on the Net", "the") 9. InStr ("Tech on the Net", "the") 9. InStr (10, "Tech on the Net", "t") 15. Left( )

28 MsgBox Left( This is a Test,2) Mid( ) MsgBox Mid( This is a Test, 6, 2) Right( ) MsgBox Right( This is a Test, 2) LTrim, Trim, RTrim Sub demotrim() MsgBox LTrim(" This is a test. ") MsgBox Trim(" This is a test. ") MsgBox RTrim(" This is a test. ") End Sub

30 <-Date > Sub demopresent()

31 Dim a As Date a = Now MsgBox a a = Date MsgBox a a = Time MsgBox a End Sub Sub demoadjustsystemclock() Date = #8/23/98# Time = #12:00:00 AM# MsgBox Now End Sub Sub demodatevalue( ) MsgBox DateValue(Now) End Sub Sub demotimevalue( ) MsgBox TimeValue(Now) End Sub

32 Sub demodatefunctions() MsgBox Year(Now) MsgBox Month(Now) MsgBox Day(Now) MsgBox Hour(Now) MsgBox Minute(Now) MsgBox Second(Now) End Sub

33 Sub demoweekday() Select Case WeekDay(Now) Case vbsunday MsgBox "Today is Sunday" Case vbmonday MsgBox "Today is Monday" Case vbtuesday MsgBox "Today is Tuesday" Case vbwednesday MsgBox "Today is Wednesday" Case vbthursday MsgBox "Today is Thursday" Case vbfriday MsgBox "Today is Friday" Case vbsaturday MsgBox "Today is Saturday" End Select End Sub Sub demodatepart() MsgBox DatePart("yyyy", Now) MsgBox DatePart("q", Now) MsgBox DatePart("m", Now) MsgBox DatePart("y", Now) MsgBox DatePart("d", Now) MsgBox DatePart("w", Now) MsgBox DatePart("ww", Now) MsgBox DatePart("h", Now)

34 MsgBox DatePart("n", Now) MsgBox DatePart("s", Now) End Sub Sub demodateserial() Dim dtedate As Date dtedate = DateSerial("2002", "5", "19") Debug.Print dtedate End Sub

35 Sub demodateadd() Dim OneYearLater As Date OneYearLater = DateAdd("yyyy", 1, Now) Select Case WeekDay(OneYearLater) Case vbsunday MsgBox "This day of the next year is Sunday"

36 Case vbmonday MsgBox "This day of the next year is Monday" Case vbtuesday MsgBox "This day of the next year is Tuesday" Case vbwednesday MsgBox "This day of the next year is Wednesday" Case vbthursday MsgBox "This day of the next year is Thursday" Case vbfriday MsgBox "This day of the next year is Friday" Case vbsaturday MsgBox "This day of the next year is Saturday" End Select End Sub Sub demodatediff() Dim TheDate As Date TheDate = InputBox("Enter a date") MsgBox "Days from today: " & DateDiff("d", Now, TheDate) End Sub Sub demodatediff1() MsgBox DateDiff("h", #10:00:00 AM#, #12:59:59 PM#) End Sub

37 Sub demodatediff2() MsgBox DateDiff("m", #7/30/98#, #8/1/98#) End Sub

38 Sub demoatan( ) MsgBox "(PI) " & 4 * Atn(1) & "" End Sub

43 Dim hfile As Long hfile=freefile

44 Open "TESTFILE" For Input As #1 '. Close #1 Open "TESTFILE" For Output Shared As #1 '. Close #1 Open "TESTFILE" For Binary Access Write As #1 '. Close #1

45 Open "TESTFILE" For Binary Access Read Lock Read As #1 Input Input. TESTFILE. Dim MyChar Open "TESTFILE" For Input As #1 '. Do While Not EOF(1) '. MyChar = Input(1, #1) '. Debug.Print MyChar '. Loop Close #1 '. input# Dim ifilenum As Integer Dim strname, strnumber, strdepart ' ifilenum = FreeFile

46 ' person.txt Open "Person.txt" For Input As ifilenum ' Input #ifilenum, strname, strnumber, strdepart ' txtname.text = strname : txtnumber.text = strnumber : txtdepart.text = strdepart Close ifilenum Line Input # Sub demo_lineinput() 'Open EOF. ' Close. ' Line Input #. 'File_Data. 'Line Input #. ' vbcrlf. '. 'Line Input # Print #. 'File_Data [ ]. Dim File_Line Dim File_Data Dim fn As String As String As Long fn = FreeFile '. Open "test.txt" For Input As #fn '. Do While Not EOF(fn) Line Input #fn, File_Line File_Line = File_Line & vbcrlf File_Data = File_Data & File_Line Loop

47 '. Close #fn '. Debug.Print File_Data End Sub Print # Sub demo_print() Open "TESTFILE.txt" For Output As #1 '. Print #1, "This is a test" '. Print #1, '. Print #1, "Zone 1"; Tab; "Zone 2" '. Print #1, "Hello"; " "; "World" '. Print #1, Spc(5); "5 leading spaces " ' 5. Print #1, Tab(10); "Hello" ' 10. ' Boolean, Date, Null Error. Dim MyBool, MyDate, MyNull, MyError MyBool = False MyDate = #2/12/1969# MyNull = Null MyError = CVErr(32767) ' True, False, Null Error '. Print #1, MyBool; " is a Boolean value" Print #1, MyDate; " is a date" Print #1, MyNull; " is a null value" Print #1, MyError; " is an error value" Close #1 ' End Sub Write #

48 Sub demo_write() Open "TESTFILE.txt" For Output As #1 '. Write #1, "Hello World", 234 '. Write #1, '. Dim MyBool, MyDate, MyNull, MyError ' Boolean, Date, Null Error. MyBool = False MyDate = #2/12/1969# MyNull = Null MyError = CVErr(32767) ' Boolean #TRUE# #FALSE#. '. # # ' Null #NULL#. ' Error #ERROR errorcode#. Write #1, MyBool; " is a Boolean value" Write #1, MyDate; " is a date" Write #1, MyNull; " is a null value" Write #1, MyError; " is an error value" Close #1 End Sub '. Dim FileLength Open "TESTFILE" For Input As #1 '. FileLength = LOF(1) '. Close #1 '. MySize = FileLen("TESTFILE") ' ()

49 Dim InputData Open "MYFILE" For Input As #1 '. Do While Not EOF(1) '. Line Input #1, InputData '. Debug.Print InputData '. Loop Close #1 '. filetoopen = Application.GetOpenFilename("Text Files (*.txt), *.txt") If filetoopen <> False Then

50 MsgBox "Open " & filetoopen End If <- >

51 <- > Sub () Dim sht As Worksheet

52 Dim col As Long Dim s Dim k Dim T Dim r Dim v Dim d1 Dim d2 Dim c As Double As Double As Double As Double As Double As Double As Double As Double col = 3 Set sht = Sheet1 s = Sheet1.Cells(16, col).value k = Sheet1.Cells(17, col).value r = Sheet1.Cells(18, col).value T = Sheet1.Cells(19, col).value v = Sheet1.Cells(20, col).value d1 = Log(s / k) + (r + Application.WorksheetFunction.Power(v, 2) * 0.5) * T d1 = d1 / (v * Sqr(T)) d2 = d1 - v * Sqr(T) With Application.WorksheetFunction c = s *.NormSDist(d1) - k * Exp(-r * T) *.NormSDist(d2) End With Sheet1.Cells(22, col) = c End Sub Dim sht As Worksheet Set sht = Sheet1

53 <- > Dim col As Long

54 col = 3 s = Sheet1.Cells(16, col) k = Sheet1.Cells(17, col) r = Sheet1.Cells(18, col) T = Sheet1.Cells(19, col) v = Sheet1.Cells(20, col) Sheet1.Cells(22, col) = c

55 <- >

56 /

歯엑셀모델링

歯엑셀모델링 I II II III III I VBA Understanding Excel VBA - 'VB & VBA In a Nutshell' by Paul Lomax, October,1998 To enter code: Tools/Macro/visual basic editor At editor: Insert/Module Type code, then compile by: