VBA-最新教程.pdf

《VBA-最新教程.pdf》由会员分享，可在线阅读，更多相关《VBA-最新教程.pdf（92页珍藏版）》请在淘文阁 - 分享文档赚钱的网站上搜索。

1、?2009.1.16?VBA?VBA?VBA?EXCEL?VBA?,?,?VBA?VBA?VBA?VBA?EXCEL?EXCEL?XLS?VBA?EXCEL?“?”?“?”?VBA?ALT?+?F11?VBA?EXCEL?“?-VBAProject”?XLS?“?”?SHEET?SHEET1?SHEET1?SHEET2?SHEET2?SHEET3?“?”?“?”?SHEET?2009.1.17?VBA(?)?2009.1.17?VBA(?)?VBA?OOP?OOP?Object Oriented Programming,?“Smalltalk?OOP?OOP?2009.1.18?VBA(?)?

2、2009.1.18?VBA(?)?2?VBA?F2?EXCEL?VBA?VBA?OFFICE?VBA?MSDN?MSDN?MSDN?VBA?OFFICE?“IF?VBA?“IF?“IF=1”?VBA?2009.1.19?2009.1.19?“?”?25?.”?Project?Object?Form?Control?Property?Worksheet?EXCEL?sheet1?sheet2?Module?VBA?Sub?End Sub?Function?End Function?Label?Textbox?CommandButton?ListBox?ComboBox?OptionButton?

3、CheckBox?Public?Private?Static?Dim?Dim myCell As Range reDim?Const?Const limit As Integer=33 As?“As Type”?Type?Byte?Integer?Long?String?Boolean?Single?Double?Currency?Decimal?Variant?Object?TYPE?IF.ELSE.END IF?DO WHILE.LOOP?DO.LOOP WHILE?FOR.NEXT?GOTO.?2009.1.20?2009.1.20?Project?Object?Form?Control

4、?Property?Worksheet?EXCEL?sheet1?sheet2?Module?VBA?Sub?End Sub?Function?End Function?HELP?.?VBA?VBA?Project?VBA?XLS?Object,?VBA?VBA?E?VBA?VBA?Row?Rows?DIM A As Range?Range?A?Set A=Sheet1.rows(1)?ROWS?Sheet1?COUNT?Form?Windows?Form?FORM?Control?Worksheet?EXCEL?sheet1?sheet2?Module?VBA?Sheet1?Sheet2?S

5、ub?End Sub?Function?End Function?Property?Range?Sheet1?Sheet1?Range?Value?A.value=0?Sheet1?“Worksheet_SelectionChange”?“A.Select”?Range?“Select”?Worksheet_SelectionChange?Sheet1?Sheet1?Private Sub Worksheet_SelectionChange(ByVal Target As Range)?Worksheet_SelectionChange?Dim A As Range?Range?Set A=S

6、heet1.Rows(1)?Sheet1?A.Value=0?Sheet1?Value?0 A.Select?Select?End Sub?EXCEL?ALT?F11?Sheet1?2009.1.21?2009.1.21?carrol?2009-1-20 15:35?ByVal?byval?“?.”?Label?Textbox?CommandButton?ListBox?ComboBox?OptionButton?CheckBox?VBA?“Label”?“Textbox”?“CommandButton”?“ListBox”?“ComboBox”?SHEET?VBA?“TextBox1”?“C

7、hange”?SHEET1?Enable?Visible,?Caption?Value?Caption?EXCEL?Sheet1?Lbl_A1?Caption?“A1?Txt_A1;?Cmd_A1;Caption?Cmd_A1_Click()?:Txt_A1.value=Cstr(Sheet1.Range(A1).value)?Sheet1?A1?A1?2009.1.22?2009.1.22?.?Public?Private?Static?Dim?Dim myCell As Range reDim?Const?Const limit As Integer=33 As?“As Type”?Typ

8、e?VBA?VBA?VBA?“Option Explicit”?Variant?PUBLIC?Option Private Module?Option Private Module?PRIVATE?DIM?STATIC?Static?“?”?2009.1.27?)?2009.1.27?)?”!?Byte?Integer?Long?String?Boolean?Single?Double?Currency?Decimal?Variant?Object?TYPE?VBA?VBA?VBA?VBA?“Name”?Name?Name?Name?INT?“INT_name”?“DATE_birthday”

9、,?NAME(2)?k(5)?ASCII?16?BYTE?BYTE?2008.1.28?2008.1.28?EXCEL?AND?OR?x1 or y2?VBA?EXCEL?EXCEL?AND?OR?EXCEL?and(?not?“+”?“-”?3”?“+-*/”?“”?23?“&”?“+-”?“+”?“-”?“not?and?or?xor”?XOR?A xor?2009.1.29?2009.1.29?IF.ELSE.END IF?DO WHILE.LOOP?DO.LOOP WHILE?FOR.NEXT?GOTO.?VBA?“IF.ELSE.END IF”?“IF”?“END IF”?IF?“I

10、F”?“ELSE”?“ELSE?“END IF”?IF?THEN?1 ELSE?2 END IF?IF?IF?END IF?IF?END IF?IF?IF?IF?IF?1 THEN?1 ELSE IF?2 THEN?2 ELSE?3 END IF END IF?EXCEL?IF?IF?SELECT CASE?CASE?1 CASE?2 CASE.ELSE CASE?3 END SELECT?DO WHILE.LOOP?DO.LOOP WHILE?FOR.NEXT?DO WHILE?1?2 LOOP?DO?1?2 LOOP WHILE?2,?DO?FOR?=1 TO N STEP?NEXT?GO

11、TO?VBA?VBA?2009.1.30?2009.1.30?VBA?VBA?(1)Public a(10)as Integer.Sub abs()For i=1 to 10 If a(i)0 then a(i)=-a(i)End If Next End Sub (2)Public a(10)as Integer.Sub abs()?Dim i as Integer For i=1 to 10 If a(i)0 then a(i)=-a(i)End If Next End Sub?VBA?”?2009.1.31?2009.1.31?Private Sub Worksheet_Selection

12、Change(ByVal Target As Range)If(Target.Column 1)Then Cells(Target.Row,1).Select End If End Sub?VBA?EXCEL?ALT?F11?“Worksheet”?“SelectionChange”?Worksheet?Sheet1?SelectionChange?A1?B1?“Target”?Range?IF?“Cells”?SHEET1?“Select”?F8?“Cells(Target.Row,1).Select”?VBA?VBA?2009.2.1?2009.2.1?EXCEL?EXCEL?Privat

13、e Sub Worksheet_SelectionChange(ByVal Target As Range)If(Target.Column 1)Then Cells(Target.Row,1).Select MsgBox?&Me.Cells(Target.Row,1)&Chr(13)_&?&Me.Cells(Target.Row,2)&Chr(13)_&?&Me.Cells(Target.Row,3)&Chr(13)_&?&Me.Cells(Target.Row,4)&Chr(13)_&?&Me.Cells(Target.Row,5)&Chr(13)_&?&Me.Cells(Target.R

14、ow,6)&Chr(13)_&?&Me.Cells(Target.Row,7)&Chr(13)_&?&Me.Cells(Target.Row,8)&Chr(13)_&?&Me.Cells(Target.Row,9)&Chr(13)_&?&Me.Cells(Target.Row,10)&Chr(13)_&?&Me.Cells(Target.Row,11)&Chr(13)_ ,vbOKOnly,?End If End Sub?Msgbox?VBA?“_”?“&”?“me”?Worksheet1?“Cells”?“Me.Cells(Target.Row,1).Value”?Value?Cells?“

15、Chr(13)”?ASCII?13?ASCII?“vbOKOnly”?OK?2009.2.2?2009.2.2?.?VBA?EXCEL?EXCEL?“Worksheet”?SelectionChange?EXCEL?Excel?100?Application?Workbook?Worksheet?Range?Chart?Application?Excel?Application?Excel?InputBox?Workbook?Excel?Excel?VBA?Excel?Workbook?Worksheet?Worksheet?Workbook?Worksheet?Worksheet?Cell?

16、Range?Excel?Excel?Chart?VBA?Workbook?Worksheet?Workbook.Worksheets?Worksheets?Count?Workbook.Worksheets.Count?Workbook.Worksheets?Workbook.Worksheets?2009.2.3?2009.2.3?VBA?VBA?EXCEL?“”?”?“CMD_pj”?“_”?CMD=Command?Autosize?False?False?True?True?Caption?Click?L1?0-100?765?-900?675?-765?540?-675?-540?60

17、?60?75?75?85?85?100?VBA?VBA?SelectionChange?“Cmd_pj_Click”?“Cmd_pj”?“Click”?“Click”?Private Sub Cmd_pj_Click()?Dim i As Integer?Dim tmp_Total As Single?tmp_Total?Sheet1.Range(K2).Select?K2?For i=2 To Sheet1.Range(K:K).End(xlDown).Row?tmp_Total=Sheet1.Cells(i,11).Value?tmp_Total Select Case tmp_Total

18、?Case 0 To 539.99?540?”?Sheet1.Cells(i,12).Value=?”Case 540 To 674.99?540?675?Sheet1.Cells(i,12).Value=?”Case 675 To 764.99?675?765?Sheet1.Cells(i,12).Value=?”Case 765 To 900?765?900?Sheet1.Cells(i,12).Value=?”Case Else?Sheet1.Cells(i,12).Value=?”End Select Select?Next For?End Sub?EXCEL?:?2009.2.4?2

19、009.2.4?Private Sub Cmd_pj_Click()?Dim i As Integer?Dim tmp_Total As Single?tmp_Total?Sheet1.Range(K2).Select?K2?For i=2 To Sheet1.Range(K:K).End(xlDown).Row?tmp_Total=Sheet1.Cells(i,11).Value?tmp_Total Select Case tmp_Total?Case 0 To 539.99?540?”?Sheet1.Cells(i,12).Value=?”Case 540 To 674.99?540?67

20、5?Sheet1.Cells(i,12).Value=?”Case 675 To 764.99?675?765?Sheet1.Cells(i,12).Value=?”Case 765 To 900?765?900?Sheet1.Cells(i,12).Value=?”Case Else?Sheet1.Cells(i,12).Value=?”End Select Select?Next For?End Sub?“Cmd_pj_Click”?Cmd_pj?DIM?:?2009.2.6?2009.2.6?A1?AF30?960?.?VBA?A1?AF30?A1?AF30?Private Sub Co

21、mmandButton1_Click()Dim i,j,p,q,x,y,u As Integer Dim tmpaddr As String p=34 q=34 x=34 y=34 w=0 Range(A34,D1000).Clear For i=1 To Sheet2.Range(a1,af30).Cells.Count tmpaddr=Sheet2.Range(a1,af30).Cells(i).Address j=CountIf(Sheet2.Range(a1,af30),Sheet2.Range(tmpaddr).Value)Select Case j Case 1:Sheet2.Ra

22、nge(A&CStr(p).Value=Sheet2.Range(tmpaddr).Value p=p+1 Range(g34).Value=CStr(p-34)Case 2:For u=34 To q-1 If Sheet2.Range(B&CStr(u).Value=Sheet2.Range(tmpaddr).Value Then GoTo exit_q End If Next Sheet2.Range(B&CStr(q).Value=Sheet2.Range(tmpaddr).Value q=q+1 Range(h34).Value=CStr(q-34)exit_q:Case 3:For

23、 u=34 To x-1 If Sheet2.Range(C&CStr(u).Value=Sheet2.Range(tmpaddr).Value Then GoTo exit_x End If Next Sheet2.Range(C&CStr(x).Value=Sheet2.Range(tmpaddr).Value x=x+1 Range(i34).Value=CStr(x-34)exit_x:Case Is 3:For u=34 To y-1 If Sheet2.Range(D&CStr(u).Value=Sheet2.Range(tmpaddr).Value Then GoTo exit_

24、y End If Next Sheet2.Range(D&CStr(y).Value=Sheet2.Range(tmpaddr).Value y=y+1 Range(j34).Value=CStr(y-34)exit_y:Case Else w=w+1 Range(k34).Value=CStr(w)End Select Next End Sub Private Function CountIf(ByVal tmpR As Range,ByVal tmpN As String)As Integer Dim a,b,c As Integer b=0 For a=1 To tmpR.Cells.C

25、ount If tmpR.Cells(a).Value=tmpN Then b=b+1 End If Next CountIf=b End Function?2009.2.7?2009.2.7?SUB?SUB?FOR?CommandButton1_Click?Function CountIf?CommandButton1?Click?SUB?FUNCTION?Private Sub CommandButton1_Click()?Private Function CountIf(ByVal tmpR As Range,ByVal tmpN As String)As Integer?Integer

26、?“Dim i,j,p,q,x,y,u As Integer”?“Dim tmpaddr As String”?“p=34”?“q=34”?“x=34”?“y=34”?“w=0”?VBA?Option Explicit?VBA?Variant?Variant?“Range(A34,D1000).Clear”?“A34?D1000”?FOR?A1?AF30?.Range(?).Cells.Count?range?Cell?Count?“tmpaddr=Sheet2.Range(a1,af30).Cells(i).Address”?TMPADDR?“j=CountIf(Sheet2.Range(a

27、1,af30),Sheet2.Range(tmpaddr).Value)”?A1?AF30?TMPADDR?2009.2.9?2009.2.9?VBA?Private Sub CommandButton1_Click()Dim i,j,p,q,x,y,u As Integer Dim tmpaddr As String p=34 q=34 x=34 y=34 w=0 Range(A34,D1000).Clear For i=1 To Sheet2.Range(a1,af30).Cells.Count tmpaddr=Sheet2.Range(a1,af30).Cells(i).Address

28、j=CountIf(Sheet2.Range(a1,af30),Sheet2.Range(tmpaddr).Value)Select Case j Case 1:Sheet2.Range(A&CStr(p).Value=Sheet2.Range(tmpaddr).Value p=p+1 Range(g34).Value=CStr(p-34)Case 2:For u=34 To q-1 If Sheet2.Range(B&CStr(u).Value=Sheet2.Range(tmpaddr).Value Then GoTo exit_q End If Next Sheet2.Range(B&CS

29、tr(q).Value=Sheet2.Range(tmpaddr).Value q=q+1 Range(h34).Value=CStr(q-34)exit_q:Case 3:For u=34 To x-1 If Sheet2.Range(C&CStr(u).Value=Sheet2.Range(tmpaddr).Value Then GoTo exit_x End If Next Sheet2.Range(C&CStr(x).Value=Sheet2.Range(tmpaddr).Value x=x+1 Range(i34).Value=CStr(x-34)exit_x:Case Is 3:F

30、or u=34 To y-1 If Sheet2.Range(D&CStr(u).Value=Sheet2.Range(tmpaddr).Value Then GoTo exit_y End If Next Sheet2.Range(D&CStr(y).Value=Sheet2.Range(tmpaddr).Value y=y+1 Range(j34).Value=CStr(y-34)exit_y:Case Else w=w+1 Range(k34).Value=CStr(w)End Select Next End Sub Private Function CountIf(ByVal tmpR

31、 As Range,ByVal tmpN As String)As Integer Dim a,b,c As Integer b=0 For a=1 To tmpR.Cells.Count If tmpR.Cells(a).Value=tmpN Then b=b+1 End If Next CountIf=b End Function?J?CASE?FOR?A1?AF30?GOTO exit_q?exit_q?FOR?FUNCTION?CountIf?VBA?VBA?VBA?1?WsCount=Activeworkbook.worksheets.count 2?a(1 to wscount)?

32、3?for each ws in activeworkbook.worksheets?4?5?worksheets?move?sheets(i)(?i?)?Sub SortSheet()Dim WsCount As Integer Dim WsArray()As String Dim Ws As Worksheet On Error Resume Next WsCount=ActiveWorkbook.Worksheets.Count ReDim WsArray(1 To WsCount)If ActiveWorkbook.ProtectStructure Then MsgBox Active

33、Workbook.Name&?,_ vbCritical,?Exit Sub End If For Each Ws In ActiveWorkbook.Worksheets t=t+1 WsArray(t)=Ws.Name Next Ws?For i=1 To UBound(WsArray)-1 For j=i+1 To UBound(WsArray)If WsArray(i)WsArray(j)Then t=WsArray(i)WsArray(i)=WsArray(j)WsArray(j)=t End If Next j Next i?Move?Sheets(i)?For i=1 To Ws

34、Count Worksheets(WsArray(i).Move before:=Sheets(i)Next i End Sub Excel2003?VBA?-?Excel2003?VBA?-?Comment?Range?Comments?For each?(1)?(2)?(3)?(4)?Comments(index)?index?Sub?()Dim Flag As Comment 1?Comments?2?Comment?Comment?For Each Flag In ActiveSheet.Comments t=t+1 Next Flag MsgBox?&t&?,vbOKOnly,?En

35、d Sub Sub CountComment()Dim Flag As Range?err?For Each Flag In ActiveSheet.UsedRange On Error Resume Next t=Flag.Comment.Text If Err=0 Then k=k+1 Next Flag MsgBox?&k&?,vbOKOnly,?End Sub Sub?()Dim a()As Range Dim Flag As Range ReDim a(ActiveSheet.Comments.Count)For i=1 To ActiveSheet.Comments.Count S

36、et a(i-1)=ActiveSheet.Comments(i).Parent Next i Set Flag=a Flag.Select End Sub Sub selectcomment()?Cells.SpecialCells(xlCellTypeComments).Select End Sub Sub?()Dim Flag As Comment For Each Flag In ActiveSheet.Comments If Flag.Visible=True Then Flag.Visible=False Else Flag.Visible=True End If Next Fla

37、g End Sub Sub DisHideComment()?application?displaycommentindicator?Indicator?If Application.DisplayCommentIndicator=xlCommentAndIndicator Then Application.DisplayCommentIndicator=xlCommentIndicatorOnly Else Application.DisplayCommentIndicator=xlCommentAndIndicator End If End Sub Sub?()?Sheet2?Sheet1

38、?ment.text?Dim Flag As Comment Dim t As Integer i=1 With Worksheets(Sheet2).Cells.Clear .Cells(1,1)=?.Cells(1,2)=?.Cells(1,3)=?For Each Flag In Worksheets(Sheet1).Comments i=i+1 t=t+1 .Cells(i,1)=t .Cells(i,2)=Flag.Parent.Address .Cells(i,3)=Flag.Parent.Comment.Text Next Flag .Columns(B:B).EntireCol

39、umn.AutoFit .Columns(C:C).ColumnWidth=34 .Cells.EntireRow.AutoFit End With End Sub Sub?()Dim Flag As Comment For Each Flag In ActiveSheet.Comments Flag.Shape.Fill.ForeColor.SchemeColor=Int(80)*Rnd+1)1-80 Flag.Shape.TextFrame.Characters.Font.ColorIndex=Int(56)*Rnd+1)1-56 Next Flag End Sub Sub?()Dim F

40、lag As Range On Error Resume Next For Each Flag In ActiveSheet.Range(g8:i17)t=t+1 Flag.AddComment.Text hner:?&t&?&Chr(13)+Chr(10)&Date Next Flag End Sub Sub test()MsgBox ActiveSheet.Range(g8).Comment.Author End Sub Sub?()Dim Flag As Range For Each Flag In ActiveSheet.Range(g8:i17)Flag.Comment.Delete

41、 Next Flag End Sub Excel2003?VBA?-?Excel2003?VBA?-?=Sales*Rate?=Sales*Rate*(1+Year/100)?0?10000?0 0.08 10000?20000?10000 0.105 20000?40000?20000 0.12 40000?40000 0.14?vlookup?=VLOOKUP(B2,$B$14:$C$17,2,TRUE)*B2?if?if?=IF(AND(B2=0,B2=$B$15,B2=$B$16,B2=$B$17),B2*$C$17,)?Function Commission1(Sales,years

42、)?Const Rate1=0.08 Const Rate2=0.105 Const Rate3=0.12 Const Rate4=0.14 Select Case Sales Case 0 To 9999.99 Case a to b?a,b?Commission1=Sales*Rate1 Case 10000 To 19999.99 Commission1=Sales*Rate2 Case 20000 To 39999.99 Commission1=Sales*Rate3 Case Else Commission1=Sales*Rate4 End Select?Commission1=Co

43、mmission1*(1+years/100)End Function Sub?()?Dim Sales Dim years As Integer Sales=Val(InputBox(?,?)years=Val(InputBox(?,?)y=MsgBox(?&Commission1(Sales,years),vbYesNo,?)If y=vbYes Then?msgbox?End If End Sub?Optional?Volatile?a1:a10?Optional?Region?range?Region(i)?Region?Function UnderstandVolatile(Regi

44、on As Range,Optional FlagBoolean As Boolean=False)?optional?Region?application.volatile true?Application.Volatile FlagBoolean?a,b?Int(rnd()*(b-a+1)+1)UnderstandVolatile=Region(Int(Rnd()*(Region.Count)+1)End Function?Optional?MonthNames(Optional Mindex)?Optional?MonthNames(Optional Mindex)?Jan?13?Jan

45、?Function MonthNames(Optional Mindex)?Ismissing(t)?true Dim AllNames As Variant AllNames=Array(Jan,Feb,Mar,_ Apr,May,Jun,Jul,Aug,_ Sep,Oct,Nov,Dec)If IsMissing(Mindex)Then MonthNames=AllNames Else Select Case Mindex Case Is=1?Jan?(Mindex-1 mod 12)?AllNames(0)?AllNames(0)MonthNames=AllNames(Mindex-1)

46、Mod 12)Case Else MonthNames=Application.WorksheetFunction.Transpose(AllNames)End Select End If End Function?ismissing?TRUE?=MonthNames()?MonthNames()?vba?vba?:?StrReverse(String)?string?null?MID(String,i,n)?string?for i=len(string)to 1 step-1 n=mid(string,i,1)?next i Function MstrReverse(Mstring)As

47、String?vba?StrReverse?MstrReverse=VBA.StrReverse(Mstring)End Function Function Mstrreverse1(Mstring)As String Dim i As Integer For i=Len(Mstring)To 1 Step-1 Mstrreverse1=Mstrreverse1&Mid(Mstring,i,1)Next i End Function Sub Mstrreverse2()Mstring=InputBox(?,?)If Mstring=Then Exit Sub MsgBox?&Mstring&?

48、&vbCrLf&MstrReverse(Mstring),vbOKOnly,?End Sub?vba?vba?vba?vbe?vba?vba?vba?vbe?ctrl+jctrl+j?vba.?vba?AlUcLcase(Mstring,Optional Mboolean As Boolean=True)?vba.?vba?AlUcLcase(Mstring,Optional Mboolean As Boolean=True)?TRUE?ASC(?97?122?=CHR(ASC(?)-32)?False?ASC(?65?90?=CHR(ASC(?)+32)?vba?ASC(?ASICC?EXC

49、EL?CODE?CHR(?EXCEL?CHAR?UCASE(?EXCEL?UPPER?LCASE(?EXCEL?LOWER?Function AlUcLcase(Mstring,Optional Mboolean As Boolean=True)As String?Dim i As Integer Dim Mlen As Integer Dim SngString As String Dim Mcode As Integer Dim AimString As String Mlen=Len(Mstring)For i=1 To Mlen SngString=VBA.Mid$(Mstring,i

50、,1)Mcode=VBA.Asc(SngString)?Ismissing?True?If IsMissing(Mboolean)Or Mboolean=True Then If Mcode=97 And Mcode=65 And Mcode 32767?Dim StartTime As Long Application.ScreenUpdating=False StartTime=Timer Const Row=40000 ReDim Marray(1 To Row)Cells.Clear For i=1 To Row Marray(i)=i Next i Range(Cells(1,1),