''application.Union 方法
''返回兩個或多個區(qū)域的合并區(qū)域 
Sub uniontext()
Sheet4.Range("a1:b3,c5:d8").Select
Union([a1:b3], [c5:d8]).Select
End Sub
'range也可以完成多區(qū)域引用
'單文本地址的引用方式最多不超過256個字符, 但是union沒有這個限制
Sub 連接符單元格連接()
Dim rng As Range
For Each rng In [b2:b10]
    adress = rng.address
    Sadress = Sadress & adress + ","
Next
Sadress = Left(Sadress, Len(Sadress) - 1)
Range(Sadress).Select
End Sub
Sub union單元格連接()   'union必須為對象
Dim rng As Range
Dim rngs As Range
Set rng = [b2]          '先申明一個變量
For Each rngs In [b2:b10]
 address = rngs.address
   Set rng = Union(rng, rngs)   ''合并起來賦值給rng
     Saddress = rng.address
Next
End Sub
Sub 條件篩選()
Dim rng As Range
For Each rng In Range([b2], Cells(Cells.Find("*", , , , , xlPrevious).Row, 2)) '對B2列
  If rng.Value > 90 Then                  ''進行判斷
      k = k + 1
      Range("D" & k) = rng.Offset(0, -1)   ''使用偏移進行賦值
      Range("E" & k) = rng
  End If
Next
End Sub
Sub S條件篩選()
Dim rng, rn, Sng As Range
For Each rng In Range([b2], Cells(Cells.Find("*", , , , , xlPrevious).Row, 2)) '對B2列
 If rng.Value > 90 Then                  ''進行判斷
    k = k + 1
    If k = 1 Then
        Set rn = rng
    Else
       Set rn = Union(rn, rng)   '    前面的單元格 連上現(xiàn)在的單元格
       aa = rn.address
    End If
 
  End If
Next
  ''對滿足條件的區(qū)域進行循環(huán)
  For Each Sng In rn
    s = s + 1
    Cells(s, "d") = Cells(Sng.Row, "a")   ''滿足條件單元格所在的行
    Cells(s, "e") = Sng
  Next
End Sub
''===============================
''單元格交集application.intersect
'返回一個range對象 表示2個或多個區(qū)域重疊的部分
Sub Intersect()
Worksheets(1).Activate
Dim isect As Range
Set isect = Application.Intersect(Range("a28:c36"), Range("c35:d32"))
 
If isect Is Nothing Then
    MsgBox "Ranges do not intersect"
Else
    'Application.Intersect(Sheet4.Range("a28:c36"), Sheet4.Range("c35:d32")).Select
End If
End Sub
Sub 隔行插入Intersect() ''插入空行
For i = 0 To Application.CountA(Columns(1)) * 2 Step 2
 Application.Intersect(Range("a1:d2").Offset(i), Range("a2:d3").Offset(i)).EntireRow.Insert
''A1：d2  and D2:D3 在相交的區(qū)域插入空行
Next
End Sub
'''獲取單元格格式
Sub 獲取單元格設(shè)置數(shù)字格式()
For Each rng In [a1:c1]
 Cells(2, rng.Column) = rng.NumberFormatLocal  ''獲取單元格的格式代碼
' Cells(3, rng.Column) = rng.NumberFormatLocal
' Cells(4, rng.Column) = rng.NumberFormatLocal
Next
End Sub
Sub 給單元格設(shè)置數(shù)字格式()
For Each rng In [a1:c3]
rng.NumberFormatLocal = "0.00"
Sheet4.Cells(4, 1).Resize(4).NumberFormatLocal = "e-m-d aaaa"   ''已cells(4,1) 調(diào)整大小向右再選4行 設(shè)置單元格格式 YYYY-M-D 星期日
Next
End Sub
Sub 保存111()
Set rng = Cells.Find("*", , , , , xlPrevious)
a = Application.CountA(Sheet1.Range("a:a"))
a = Sheet1.Cells.Find("*", , , , , xlPrevious).Row
Sheet1.Range("a5", "e" & a).Copy Sheet4.Cells(a + 1, 1)
End Sub
''Font對象 包含對象的字體屬性（字體名字,字號,顏色等等）
'range.clearformats  ''清除對象的格式設(shè)置
Sub font屬性()
With [a2:a6].Font
        .name = "微軟雅黑"        '字體
        .Size = 8               '字號
        .Bold = True            '加粗
        .Color = RGB(255, 0, 255) '顏色
        .ColorIndex = 7            '顏色
End With
End Sub
Sub 大于90分顏色設(shè)置()
Dim a As Range
Dim rng As Range
Sheet1.Cells(Rows.Count, 1).End(xlUp).Select
Set a = Cells(Rows.Count, 1).End(xlUp)   ''最后單元格向上移動
 Range("a1", a).ClearFormats
For Each rng In Range("a1", a)
 If rng.Value > 90 Then
    With rng.Font
        .name = "華文琥珀"
        .Size = 9
        .Bold = True
        .Color = RGB(255, 0, 255)
    End With
 
 End If
Next
End Sub
''Interior 對象
''代表一個對象的內(nèi)部
Sub 單元格底部顏色() ''顏色索引值
For i = 1 To 56
Sheet4.Cells(i, 1).Interior.ColorIndex = i
Sheet4.Cells(i, 2) = i
Next
End Sub
Sub 早期顏色值()
For i = 0 To 15  ''16中顏色
Cells(i + 1, 4).Interior.Color = QBColor(i)
Cells(i + 1, 5) = i
Next
End Sub
Sub 三原色()
Cells(2, 8).Interior.Color = RGB([H1], [I1], [J1])
End Sub
Sub 直接顏色()  '此顏色有 255*255*255 中顏色
Cells(3, 8).Interior.Color = 10
End Sub
Sub 實例格式化單元格()
Dim i%
i = Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To i
   If j Mod 2 Then   ''如果有余數(shù)    'EntireRow 整行
''range.range 它是以默認(rèn)前面單元格中的左上單元格為準(zhǔn)  對前面整行的 A1：G1
      With Cells(j, 1).EntireRow.Range("a1:g1").Font
         .Bold = True
         .Size = 9
         .ColorIndex = 3
      End With
   Else
      Cells(j, 1).EntireRow.Range("a1:g1").Interior.ColorIndex = 40
   End If
Next
 
End Sub
Sub 清除格式化() '選擇區(qū)域清除格式化
Selection.ClearFormats
End Sub
Sub 查找功能拾取顏色求平均分()
 
On Error GoTo 100
Dim erng As Range, rng As Range, i As Long
i = Application.FindFormat.Interior.Color     ''利用 findformat 查找顏色的功能  返回拾取到的顏色值返回給 i
Set erng = Cells(Rows.Count, "e").End(xlUp)   ''直接返回最后個單元格
For Each rng In Range("a1", erng)
  If rng.Interior.Color = i Then
      k = k + rng.Value
      n = n + 1
     
  End If
Next
MsgBox k / n
Exit Sub
100:
MsgBox "查找功能沒有拾取到顏色"
End Sub