【Excel VBA】變 儲存格背景 文字 顏色

Worksheets("xxx").Range("F" 1).interior.ColorIndex = 15

Worksheets("xxx").Range("F"1).Font.ColorIndex = 15

【Excel VBA】 日期比較，西元轉民國

today = Date
textY = Val(Year(today) - 1911)


textM = Month(today)
If (Len(textM) < 2) Then
textM = "0" + textM
End If

textD = Day(today)
If (Len(textD) < 2) Then
textD = "0" + textD
End If


i = 1


'today = CDate(textY + "/" + textM + "/" + textD)
today = CDate("103/12/31")
 MsgBox today
 MsgBox CDate(Worksheets("xxx").Range("E" & i + 1).Value)

 If (today > CDate(Worksheets("xxx").Range("E" & i + 1).Value)) Then


   MsgBox today & "> " & Worksheets("xxx").Range("E" & 1 + 1).Value

 End If


  If (today < Worksheets("xxx").Range("E" & i + 1).Value) Then


   MsgBox today & "< " & Worksheets("xxx").Range("E" & 1 + 1).Value

 End If
             

【Excel VBA】 Error Trapping 錯誤處理

'表示當一個執行階段錯誤產生時，程式控制立刻到發生錯誤陳述式接下去的陳述式，而繼續執行下去。
On Error Resume Next
Err.Clear




                    '放在有可能發生錯誤的後面
                    'Err.Raise 6
                    If (Err.Number <> 0) Then
                   
 
Msgbox "Error # " & Str(Err.Number) & " was generated by " & Err.Source & ControlChars.CrLf & Err.Description
                     
                    Err.Clear
                   
                    End If

【Excel VBA】文字操作。string manipulation, parsing

Join Strings
We use the & operator to concatenate (join) strings.Code:
Dim text1 As String, text2 As String
text1 = "Hi"
text2 = "Tim"
MsgBox text1 & " " & text2
=> Hi Tim

Left
To extract the leftmost characters from a string, use Left.
Code:
Dim text As String
text = "example text"
MsgBox Left(text, 4)
=>exam


Right
To extract the rightmost characters from a string, use Right.
We can also directly insert text in a function.Code:
MsgBox Right("example text", 2)
=>xt


Mid
To extract a substring, starting in the middle of a string, use
 ' Creates text string.
Dim TestString As String = "Mid Function Demo"

' Returns "Mid".
Dim FirstWord As String = Mid(TestString, 1, 3)

' Returns "Demo".
Dim LastWord As String = Mid(TestString, 14, 4)

' Returns "Function Demo".
Dim MidWords As String = Mid(TestString, 5)
(第三欄不填，可以抓到結尾)


Len(含空白)
To get the length of a string, use Len.
Code:
MsgBox Len("example text")
=>12


Instr
To find the position of a substring in a string, use Instr.
Code:
MsgBox Instr("example text", "am")
=> 3



Compare two strings.
StrComp


Convert strings.
StrConv


Reverse a string.
InStrRev, StrReverse


Convert to lowercase or uppercase.
Format, LCase, UCase


Create a string of repeating characters.
Space, StrDup


Find the length of a string.
Len


Format a string.
Format, FormatCurrency, FormatDateTime, FormatNumber, FormatPercent

【Excel VBA】 小工具

【Excel VBA】關閉螢幕更新

Application.ScreenUpdating = False
'xxxxxxxxxxxxxxxx
Application.ScreenUpdating = True





【Excel VBA】開一個新的sheet

 Sheets.Add After:=Sheets(Sheets.Count)
 ActiveSheet.Name = "XXXXX"

'xxxxxxxxxxxx

    '【Excel VBA】關掉最sheet
    Application.DisplayAlerts = False
    Sheets("XXXXX").Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True





    'AutoFit All Columns on Worksheet
    ThisWorkbook.Worksheets("xxxxxxx" ).Cells.EntireColumn.AutoFit



'【Excel VBA】調整一下表格大小
ThisWorkbook.Worksheets("xxxxxxx" ).Columns.ColumnWidth = 10
ThisWorkbook.Worksheets("xxxxxxx" ).Rows.RowHeight = 30
ThisWorkbook.Worksheets("xxxxxxx" ).Columns("E").ColumnWidth = 50



'【Excel VBA】取得當下的row 數 column 數
    DataRange = Worksheets("xxxxx").Cells(Worksheets("xxxxx").Rows.Count, "A").End(xlUp).Row   '包含空白!! 用這個
    LastColumn = Worksheets("xxxxx").UsedRange.Columns(Worksheets("xxxxx").UsedRange.Columns.Count).Column




'【Excel VBA】複製A 的第 i+row 到 B的 k+1 row

                                 Worksheets("A").Rows(i + 1).EntireRow.Copy
                                 Worksheets("B").Range("A" & k + 1).Select
                                 Worksheets("B").Paste

【Excel VBA】 中文日期轉成六位數字含斜線表示法。YYY年M月D日 轉成 YYY/0M/0D

Dim tempposY As String
Dim tempposM As String
Dim tempposD As String
Dim textY As String
Dim textM As String
Dim textD As String    
'目的 將國字的年月 轉成 6未數的表示  104年3月5日 => 104/03/05
'假設字串為。小心這邊字串最後沒有日。有的話下面稍微調整一下即可

retval="104年3月5"

 '看看裡面有沒有　年　月
    If (InStr(retval, "年")) Then


        tempposY = InStr(retval, "年")
        tempposM = InStr(retval, "月")
        tempposD = InStr(retval, "日")


        MsgBox Len(retval)
       MsgBox tempposY & " " & tempposM & " " & tempposD


        textY = Left(retval, tempposY - 1)
        textM = Mid(retval, tempposY + 1, tempposM - tempposY - 1)
        textD = Mid(retval, tempposM + 1, tempposD - tempposM - 1)

        If Len(textM) < 2 Then

            textM = "0" + textM

        End If
        If Len(textD) < 2 Then

            textD = "0" + textD

        End If


'        MsgBox textY
'        MsgBox textM
'        MsgBox textD

        retval = textY + "/" + textM + "/" + textD

        'MsgBox retval
   

endif

【Excel VBA】 把數字(含小數點和，)從字串中抽出來。

'把數字從字串中抓出來
Function extractDigits(s As String) As String
    ' Variables needed (remember to use "option explicit").   '
    Dim retval As String    ' This is the return string.      '
    Dim i As Integer        ' Counter for character position. '

    ' Initialise return string to empty                       '
    retval = ""

    ' For every character in input string, copy digits to     '
    '   return string.                                        '
    For i = 1 To Len(s)
        If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Or Mid(s, i, 1) = "." Or Mid(s, i, 1) = "," Then
            retval = retval + Mid(s, i, 1)
        End If
    Next

    ' Then return the return string.                          '
    onlyDigits = retval
End Function



使用方法

result=extractDigits("ABCD13.5EFGR")

【Excel VBA】取得某網頁的原始html程式碼。

    Dim web, url, webdata
   
    ThisWorkbook.Worksheets("xxxx").Cells.ClearContents  '清除之前資料
   
    url = "http://xxxxxxxxxxxxxxxxxx"
    Set web = CreateObject("Microsoft.XMLHTTP")
    web.Open "get", url, False
    web.send
    webdata = Split(web.responseText, vbLf)
   
   
    For j = 0 To UBound(webdata)
         ThisWorkbook.Worksheets("xxxx").Cells(j + 1, 1).NumberFormatLocal = "@" '將儲存格設為文字.否則遇到有等號開頭就會出錯'
         ThisWorkbook.Worksheets("xxxx").Cells(j + 1, 1).Value = webdata(j)
    Next




取得html原始碼之後，就可以像python 一樣，拿來爬了。