接了幾個 Excel VBA 的案子下來，有些 function 其實還蠻常用到的，每次再去翻檔案還蠻麻煩的，就寫篇文章把它們記下來。
一般用途
Sheet Row Count
活頁本的 Row Count
|
1 2 3 4 |
Function RowCount(s As Worksheet) lastrow = s.Cells(s.Rows.Count, 1).End(xlUp).Row RowCount = lastrow End Function |
Sheet Column Count
活頁本的 Column Count
|
1 2 3 4 |
Function ColCount(s As Worksheet) lastcol = s.Cells(1, s.Columns.Count).End(xlToLeft).Column ColCount = lastcol End Function |
排序
可依兩個欄位對活頁本排序，若只需要一個，則將K2設成空即可。
|
1 2 3 4 5 6 7 8 |
Sub MySort(s As Worksheet, K1 As String, K2 As String) Row = RowCount(s) If Len(K2) > 0 Then s.Range("A1", "ZZ" & Row).Sort Key1:=s.Range(K1), Order1:=xlAscending, Key2:=s.Range(K2), Order2:=xlAscending, Header:=xlYes Else s.Range("A1", "ZZ" & Row).Sort Key1:=s.Range(K1), Order1:=xlAscending, Header:=xlYes End If End Sub |
我的 VLookup
VLookup 在查詢時，常會碰到數字/文字混查的狀況，這會讓查詢失敗。所以要都轉換成文字，除了要把格式設為文字外，還要在加一個空白，才能確保其轉換為文字狀態。
Number2Text() 的 function 是需要使用者自行修改的部份，把你要查詢的地方套用上去，以將之設為文字。而MyVLookup()功能與VLookup()功能相同，但在查找不到時，會傳回 “NA”。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 |
Private Sub Number2Text() 工作表1.Range("A1:ZZ" & 工作表1Rows).NumberFormat = "@" Sheet1.Range("A1:ZZ" & Sheet1Rows).NumberFormat = "@" Sheet6.Range("A1:ZZ" & Sheet6Rows).NumberFormat = "@" Sheet10.Range("A1:ZZ" & Sheet10Rows).NumberFormat = "@" Sheet4.Range("A1:ZZ" & Sheet4Rows).NumberFormat = "@" For I = 2 To RowCount(工作表1) 工作表1.Cells(I, 1) = Trim(工作表1.Cells(I, 1)) + " " Next I For I = 2 To RowCount(Sheet1) Sheet1.Cells(I, 2) = Trim(Sheet1.Cells(I, 2)) + " " Next I For I = 2 To RowCount(Sheet6) Sheet6.Cells(I, 1) = Trim(Sheet6.Cells(I, 1)) + " " Next I For I = 2 To RowCount(Sheet10) Sheet10.Cells(I, 1) = Trim(Sheet10.Cells(I, 1)) + " " Next I For I = 2 To RowCount(Sheet4) Sheet4.Cells(I, 1) = Trim(Sheet4.Cells(I, 1)) + " " Next I End Sub Function MyVlookup(A As Range, B As Range, C As Integer, D As Boolean) MyVlookup = Application.VLookup(A + " ", B, C, D) If IsError(MyVlookup) Then MyVlookup = "NA" End If End Function |
複製範圍到另一處
|
1 |
Sheet3.Range("A1:N" & RowCount(Sheet3)).Copy Destination:=Sheet5.Range("B1") |
抓取 WEB 網頁內容
|
1 2 3 4 5 6 7 8 9 |
Dim xmlhttp as new msxml2.xmlhttp60 'Following two lines are also ok but without auto completion 'Dim xmlhttp as object 'Set xmlhttp = CreateObject("MSXML2.serverXMLHTTP) Dim myurl as String myurl = "https://tw.yahoo.com" xmlhttp.open "GET", myurl, false xmlhttp.send msgbox(xmlhttp.responseText) |
要啟用上面的程式碼需要設定引用XML 6.0 Library。開啟 Visual Basic 設計模式，按下 【工具 –> 設定引用項目】。然後選擇 Microsoft XML 6.0 即可。
定時執行 Timer
在 Sheet1 上增加一個 buttun, 並使用下列程式碼
|
1 2 3 4 5 6 7 8 9 10 |
Public RunTimer As Boolean Private Sub CommandButton1_Click() If RunTimer = False Then RunTimer = True MyTimer Else RunTimer = False End If Cells(2, 2) = RunTimer End Sub |
手動新增一個巨集，應該會產生 Module1 模組
|
1 2 3 4 5 6 |
Sub MyTimer() If Sheet1.RunTimer Then Application.OnTime Now + TimeValue("00:00:01"), "MyTimer" Cells(1, 1) = Time End If End Sub |
按下button後應該就會開始計時
