9 Range 實用操做

9.1 剪切、複製和粘貼來移動數據

sourceRange.Cut [Destination]

若是指定Destination，至關於Ctrl^X(sourceRange) & Ctrl^V(Destination)。若是沒有指定就至關於Ctrl^X(sourceRange)。

 

sourceRange.Copy [Destination]

若是指定Destination，至關於Ctrl^C(sourceRange) & Ctrl^V(Destination)。若是沒有指定就至關於Ctrl^C(sourceRange)。

 

Application.CutCopyMode = False 能夠關閉cut/copy時，單元格周圍移動的虛線框。

 

destinationRange.PasteSpecial

    [paste as xlPasteType],

    [operation as xlPasteSpecialOperation],

    [SkipBlanks as boolean],

    [Transpose]

其中:

Paste := [xlPasteAll]|xlPasteAllExceptBorders|xlPasteColumnWidths|xlPasteComments|xlPasteFormats|xlPasteFormulas

              |xlPasteFormulasAndNumberFormats|xlPasteValidation|xlPasteValues|xlPasteValuesAndNumberFormats

operation := [xlPasteSpecialOperationNone]|xlPasteSpecialOperationAdd|xlPasteSpecialOperationDivide|xlPasteSpecialOperationMultiply|xlPasteSpecialOperationSubstract

operation 指的是是否對源範圍內的數值進行簡單的算術運算。

skipBlanks 指是否忽略源範圍的空白單元格，默認是False，不忽略。

Transpose 指是否轉置，默認爲False，不轉置。

 

rangeToDelete.Delete [Shift as XlDeleteShiftDirection]

其中：

    Shift := xlShiftToLeft | xlShiftUp。Used only with Range objects. Specifies how to shift cells to replace deleted cells. Can be one of the following XlDeleteShiftDirection constants: xlShiftToLeft or xlShiftUp. If this argument is omitted, Microsoft Excel decides based on the shape of the range.

9.2 查找咱們的目標

expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)

參見：http://msdn.microsoft.com/en-us/library/ff839746(v=office.15).aspx

expression.FindNext(After)

expression.FindPrevious(After)

參見：http://msdn.microsoft.com/en-us/library/ff196143(v=office.15).aspx

以及：http://msdn.microsoft.com/en-us/library/ff838614(v=office.15).aspx

代碼清單9.1：使用Find和Copy方法 

'name of worksheet
Private Const WORKSHEET_NAME = "Find Example"

'Name of range used to flag beginning of found list
Private Const FOUND_LIST = "FoundList"

'Name of range that contains the product look for
Private Const LOOK_FOR = "LookFor"

Sub FindExample()
    Dim ws As Worksheet
    Dim rgSearchIn As Range
    Dim rgFound As Range
    Dim sFirstFound As String
    Dim bContinue As Boolean
    
    ResetFoundList
    Set ws = ThisWorkbook.Worksheets(WORKSHEET_NAME)
    bContinue = True
    Set rgSearchIn = GetSearchRange(ws)
    
    'find the first instance of DLX
    'looking at all cells on the worksheet
    'looking at the whole contents of the cell
    Set rgFound = rgSearchIn.Find(ws.Range(LOOK_FOR).Value, xlValue, xlWhole)
    
    'if we found something, remember where we found it
    'this is needed to terminate the do...loop later on
    If Not rgFound Is Nothing Then sFirstFound = rgFound.Address
    
    Do Until rgFound Is Nothing Or Not bContinue
        CopyItem rgFound
        
        'find the next instance starting with the
        'cell after the one we just found
        Set rgFound = rgSearchIn.FindNext(rgFound)
        
        'FindNext doesn 't automatically stop when it
        'reaches the end of the worksheet - rather
        'it wraps around to the beginning again.
        'we need to prevent an endless loop by stopping
        'the process once we find something we've already found
        If rgFound.Address = sFirstFound Then bContinue = False
    Loop
    
    Set rgSearchIn = Nothing
    Set rgFound = Nothing
    Set ws = Nothing    
End Sub

'sets a range reference to the range containing the list - the product column
Private Function GetSearchRange(ws As Worksheet) As Range
    Dim lLastRow As Long
    
    lLastRow = ws.Cells(65536, 1).End(xlUp).Row
    Set GetSearchRange = ws.Range(ws.Cells(1, 2), ws.Cells(lLastRow, 2))    
End Function

'copies item to found list range
Private Sub CopyItem(rgItem As Range)
    Dim rgDestination As Range
    Dim rgEntireItem As Range
    
    'need to use a new range object because
    'we will be altering this reference.
    'altering the reference would screw up
    'the find next process in the findExample
    'procedure. also - move off of header row
    Set rgEntireItem = rgItem.Offset(0, -1)
    
    'resize reference to consume all four columns associated with the found item
    Set rgEntireItem = rgEntireItem.Resize(1, 4)
    
    'set initial reference to found list
    Set rgDestination = rgItem.Parent.Range(FOUND_LIST)
    
    'find first empty row in found list
    If IsEmpty(rgDestination.Offset(1, 0)) Then
        Set rgDestination = rgDestination.Offset(1, 0)
    Else
        Set rgDestination = rgDestination.End(xlDown).Offset(1, 0)
    End If
    
    'copy the item to the found list
    rgEntireItem.Copy rgDestination
    Set rgDestination = Nothing
    Set rgEntireItem = Nothing   
End Sub

'clears contents from the found list range
Private Sub ResetFoundList()
    Dim ws As Worksheet
    Dim lLastRow As Long
    Dim rgTopLeft As Range
    Dim rgBottomRight As Range
    
    Set ws = ThisWorkbook.Worksheets(WORKSHEET_NAME)
    Set rgTopLeft = ws.Range(FOUND_LIST).Offset(1, 0)
    lLastRow = ws.Range(FOUND_LIST).End(xlDown).Row
    Set rgBottomRight = ws.Cells(lLastRow, rgTopLeft.Offset(0, 3).Column)
    
    ws.Range(rgTopLeft, rgBottomRight).ClearContents
    
    Set rgTopLeft = Nothing
    Set rgBottomRight = Nothing
    Set ws = Nothing
End Sub

  

9.3 使用Replace替換

expression.Replace(What, Replacement, LookAt, SearchOrder, MatchCase, MatchByte, SearchFormat, ReplaceFormat)

參見：http://msdn.microsoft.com/en-us/library/ff194086(v=office.15).aspx

代碼清單9.2：使用Replace以程序設計的方式設置正確的範圍 

Sub ReplaceExample()
    Dim ws As Worksheet
    Dim rg As Range
    Dim lLastRow As Long
    
    Set ws = ThisWorkbook.Worksheets("Replace Examples")
    
    'determine last cell in data range
    'assumes the would never be an empty cell
    'in column 1 at the bottom of the list
    lLastRow = ws.Cells(65536, 1).End(xlUp).Row
    
    'Replace empty cells in 2nd & 3rd columns
    Set rg = ws.Range(ws.Cells(2, 2), ws.Cells(lLastRow, 3))
    rg.Replace "", "UNKNOWN"
    
    'Replace empty cells in 4th column
    Set rg = ws.Range(ws.Cells(2, 4), ws.Cells(lLastRow, 4))
    rg.Replace "", "0"
    
    Set rg = Nothing
    Set ws = Nothing
End Sub

 

代碼清單9.3：使用Replace替換格式 

Sub ReplaceFormats()
    'set formatting to look for
    With Application.FindFormat
        .Font.Bold = True
        .Font.Size = 11
    End With
    
    'set formatting that should be applied instead
    With Application.ReplaceFormat
        .Font.Bold = False
        .Font.Italic = True
        .Font.Size = 8
    End With
    
    ActiveSheet.Cells.Replace What:="", Replacement:="", SearchFormat:=True, ReplaceFormat:=True    
End Sub

 

9.4 喜歡它的特別調味品嗎？

expression.SpecialCells(Type, Value)

參見：http://msdn.microsoft.com/en-us/library/ff196157(v=office.15).aspx

代碼清單9.4：當使用SpecialCells時，使用錯誤處理

Sub SpecialCells()
    Dim ws As Worksheet
    Dim rgSpecial As Range
    Dim rgCell As Range
    On Error Resume Next
    
    Set ws = ThisWorkbook.Worksheets("Special Cells")
    Set rgSpecial = ws.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
    
    If Not rgSpecial Is Nothing Then
        rgSpecial.Interior.Color = vbRed
    Else
        MsgBox "congratulations! " & ws.Name & " is an error-free worksheet."
    End If
    
    Set rgSpecial = Nothing
    Set rgCell = Nothing
    Set ws = Nothing
End Sub

 

9.5 CurrentRegion：一個有用的捷徑

Range對象的CurrentRegion屬性

參見：http://msdn.microsoft.com/en-us/library/ff196678(v=office.15).aspx

Range對象的ListHeaderRows屬性

參見：http://msdn.microsoft.com/en-us/library/ff839644(v=office.15).aspx

代碼清單9.5：調用CurrentRegion觀察一個列表的有用特徵

Sub CurrentRegionExample()
    Dim ws As Worksheet
    Dim rg As Range
    
    Set ws = ThisWorkbook.Worksheets("Current Region")
    
    'get current regionassociated with cell A1
    Set rg = ws.Cells(1, 1).CurrentRegion
    
    'number of header rows
    ws.Range("I2").Value = rg.ListHeaderRows
    
    'number of columns
    ws.Range("I3").Value = rg.Columns.Count
    
    'resize to exclude header rows
    Set rg = rg.Resize(rg.Rows.Count - rg.ListHeaderRows, rg.Columns.Count).Offset(1, 0)
    
    'number of rows ex header rows
    ws.Range("I4").Value = rg.Rows.Count
    
    'number of cells ex header rows
    ws.Range("I5").Value = rg.Cells.Count
    
    'number empty cells ex header rows
    ws.Range("I6").Value = Application.WorksheetFunction.CountBlank(rg)
    
    'number of numeric cells ex header rows
    ws.Range("I7").Value = Application.WorksheetFunction.Count(rg)
    
    'last row
    ws.Range("I8").Value = rg.Rows.Count + rg.Cells(1, 1).Row - 1
    
    Set rg = Nothing
    Set ws = Nothing    
End Sub

 

9.6 列表簡單排序

expression.Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3)

參見：http://msdn.microsoft.com/en-us/library/ff840646(v=office.15).aspx

中文排序：

expression.SortSpecial(SortMethod, Key1, Order1, Type, Key2, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, DataOption1, DataOption2, DataOption3)

參見：http://msdn.microsoft.com/en-us/library/ff822807(v=office.15).aspx

代碼清單9.6：增長工做表列表的可單擊排序

Dim mnDirection As Integer
Dim mnColumn As Integer

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'make sure the double-click occurred in a cell
    'containing column labels
    If Target.Column < 5 And Target.Row = 1 Then
        'see if we need to toggle the direction of the sort
        If Target.Column <> mnColumn Then
            'clicked in new column - record
            
            'which column was clicked
            mnColumn = Target.Column

            'set default direction
            mnDirection = xlAscending
        Else
            'clicked in same column toggle the sort direction
            If mnDirection = xlAscending Then
                mnDirection = xlDescending
            Else
                mnDirection = xlAscending
            End If
        End If
        TestSort
    End If
End Sub

Private Sub TestSort()
    Dim rg As Range
    
    'get current region associated with cell A1
    Set rg = Me.Cells(1, 1).CurrentRegion
    
    'ok - sort the list
    rg.Sort key1:=rg.Cells(1, mnColumn), order1:=mnDirection, Header:=xlYes
    
    Set rg = Nothing    
End Sub