VBA-最新教程.pdf
?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(?)?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?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?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?Sub?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=Sheet1.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”?“Change”?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”?Type?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”,?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?“IF”?“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?GOTO?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_SelectionChange(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?Private 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.Row,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?“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?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?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?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?2009.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?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?“Cmd_pj_Click”?Cmd_pj?DIM?:?2009.2.6?2009.2.6?A1?AF30?960?.?VBA?A1?AF30?A1?AF30?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 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&CStr(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:For 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 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?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?“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(a1,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 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&CStr(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:For 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 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)?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 ActiveWorkbook.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 WsCount 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,?End 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 Set 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 Flag 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?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).EntireColumn.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 Flag 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 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)?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=Commission1*(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(Region 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?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)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 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&?&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?EXCEL?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,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),
