vba操作工作表單元格

Sub CreateSheets()
    Dim i
    For i = 1 To 30 Step 1
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = "4月" & i
    Next
End Sub

Sub DeleteSheets()
    Dim sht
    Excel.Application.DisplayAlerts = False
    For Each sht In Sheets
        If sht.Name <> "Sheet1" Then
            sht.Delete
        End If
    Next
    Excel.Application.DisplayAlerts = True
End Sub

sub Copy()
    ' 雖然手冊裏說明返回對象，但是實踐中無法獲取,會報運行時錯誤要求對象。需要引用複製後的對象
    ' TypeName(ActiveSheet.Copy(after:=Sheets(Sheets.Count)))返回boolean
    'Set sht = Activesheet.copy().name="xxxx"
    dim sht
    activesheet.Copy
    set sht = activesheet
    sht.name = "xxx"
end sub

sub Test1()
    'range選擇

    Cells.Interior.Color = vbWhite
    Dim rng
    Set rng = Range("a1:b2,c4")
    rng.Interior.Color = vbRed
    Union(Range("d1"), Range("d3")).Select
    Range("f2:f10 d2:g2").Select
    Range("b3:d3,e4:f2").Interior.Color = vbYellow
    '矩形區域
    Range("b3:d3", "e4:f2").Interior.Color = vbYellow

    '整行整列
    Range("d6").EntireRow.Interior.Color = vbBlue
    Range("d6").EntireColumn.Interior.Color = vbYellow
    
    [b3].select
    Range("1:2").EntireRow.Interior.Color = vbBlue
    Range("e:f").EntireColumn.Interior.Color = vbYellow

    '內容的最後一行
    With ActiveSheet.UsedRange
        MsgBox .Rows(.Rows.Count).Row
    End With
    
    MsgBox [b65536].End(xlUp).Row
    '選中單元格同時可激活其他單元格
    
    '不帶格式複製
    [h1:h8].Value = [b1:b8].Value

end sub

sub Test2()
    '隔行（內容不同）塗色
    dim line,flag
    line = 3
    flag = false
    do while cells(line,1)<>""
        if cells(line,1)<>cells(line-1,1) Then
            flag = not flag
        end if

        if flag Then
            cells(line,1).resize(1,48).interior.color = rgb(255,0,0)
        end if

        line = line +1
    loop
end sub

Sub test3()
    ',a,,b,,c
    Dim arr, arr1() As String, ele, i, j
    arr = Split([a1].Value, ",")
    ReDim arr1(1 To UBound(arr) - LBound(arr) + 1)
    j = 1
    For i = LBound(arr) To UBound(arr)
        arr1(j) = arr(i)
        j = j + 1
    Next
    For Each ele In arr1
        If Not ele = "" Then Debug.Print ele
    Next
End Sub

sub Test4()
    '開始行 截至行
    dim startLine,endLine,used
    set used = activesheet.usedrange
    startLine = used.row
    'endLine = used.Rows(used.Rows.Count).Row
    'endLine = startLine + used.Rows.Count - 1
    endLine = range("a"  & rows.count).end(xlup).row
    'cells(4,columns.count).end(xltoleft)
    msgbox startLine & " / " & endLine

    '選擇粘貼
    Range("b4").CurrentRegion.Copy
    With Sheets("sheet4").Range("b2")
      .PasteSpecial xlPasteColumnWidths
      .PasteSpecial xlPasteAll
    End With
    Excel.Application.CutCopyMode = False
    
end sub