VBA? VBA. VBA. VBA. 4.x VBA VBA. VBA VBA. VBA,. VBA VBA. VBA., VBA. VBA (,, ). VBA.,. VBA,,. VBA,,,.
VBA,,...,. VBA.. VBA.
VBA. VBA......
. B2..... Sub Macro1() ' ' Macro1 Macro ' pp () 2005-01-14 ' 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
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.
VBA....
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 = 20000 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
Sub Option1() Dim payoff Dim k Dim s Dim p Dim response p = 3000 k = 20000 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
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
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,,.
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
1.IF THEN ELSE A -21. If A>0 Then A. -21 0 If A>0 Then Then (MsgBox A is greater than zero ) ElseIf A<0 Then.
2.SELECT CASE Case 1 To 4, 7 To 9, 11, 13, Is >
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)
Debug.Print Format(stdev, "0.00%") Debug.Print Format(yld_year, "0.00%") End Sub
2.FOR EACH IN~NEXT
3.DO...LOOP Do While~Loop (True) (False). Do Until~Loop (True). Do~Loop While (True) (False).
Do~Loop Until (True). Do~Loop. Do~Loop. Exit Do.
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
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( )
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( )
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( )
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
<-Date > Sub demopresent()
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
Sub demodatefunctions() MsgBox Year(Now) MsgBox Month(Now) MsgBox Day(Now) MsgBox Hour(Now) MsgBox Minute(Now) MsgBox Second(Now) End Sub
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)
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
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"
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
Sub demodatediff2() MsgBox DateDiff("m", #7/30/98#, #8/1/98#) End Sub
Sub demoatan( ) MsgBox "(PI) " & 4 * Atn(1) & "" End Sub
Dim hfile As Long hfile=freefile
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
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
' 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
'. 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 #
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#. '. #1994-07-13# ' 1994 7 13. 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") ' ()
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
MsgBox "Open " & filetoopen End If <- >
<- > Sub () Dim sht As Worksheet
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
<- > Dim col As Long
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
<- >
/