VBA學(xué)習(xí)筆記-02

VBA學(xué)習(xí)筆記

筆記摘抄自EXCEL精英培訓(xùn)-藍(lán)色幻想

VBA學(xué)習(xí)筆記01（鏈接）
VBA學(xué)習(xí)筆記02 （鏈接）

CH6 單元格操作

一刨裆、單元格的選取

1 表示一個(gè)單元格(a1)

 Sub s()
       Range("a1").Select
       Cells(1, 1).Select
       Range("A" & 1).Select
       Cells(1, "A").Select
       Cells(1).Select
       [a1].Select
 End Sub

2 表示相鄰單元格區(qū)域

 Sub d()                              ‘選取單元格a1:c5
         Range("a1:c5").Select
         Range("A1", "C5").Select
         Range(Cells(1, 1), Cells(5, 3)).Select
         Range("a1:a10").Offset(0, 1).Select
        Range("a1").Resize(5, 3).Select
 End Sub

3 表示不相鄰的單元格區(qū)域

Sub d1()

  Range("a1,c1:f4,a7").Select
  
  Union(Range("a1"), Range("c1:f4"), Range("a7")).Select
  
End Sub

Sub dd() union示例
  Dim rg As Range, x As Integer
  For x = 2 To 10 Step 2
    If x = 2 Then Set rg = Cells(x, 1)
    
    Set rg = Union(rg, Cells(x, 1))
  Next x
  rg.Select
End Sub

4 表示行

Sub h()    
  Rows(1).Select
  Rows("3:7").Select
  Range("1:2,4:5").Select
   Range("c4:f5").EntireRow.Select       
End Sub

5 表示列

 Sub L()    
   Columns(1).Select
   Columns("A:B").Select
   Range("A:B,D:E").Select
  Range("c4:f5").EntireColumn.Select 選取c4:f5所在的行       
 End Sub

6 重置坐標(biāo)下的單元格表示方法

Sub cc()

  Range("b2").Range("a1") = 100
  
End Sub

7 表示正在選取的單元格區(qū)域

 Sub d2()
       Selection.Value = 100
 End Sub

二梗摇、特殊單元格定位

1 已使用的單元格區(qū)域

Sub d1()  
      Sheets("sheet2").UsedRange.Select    
      wb.Sheets(1).Range("a1:a10").Copy Range("i1")    
End Sub

2 某單元格所在的單元格區(qū)域

 Sub d2()    
      Range("b8").CurrentRegion.Select    
 End Sub

3 兩個(gè)單元格區(qū)域共同的區(qū)域

Sub d3()     
      Intersect(Columns("b:c"), Rows("3:5")).Select  
End Sub

4 調(diào)用定位條件選取特殊單元格

Sub d4()  
   Range("A1:A6").SpecialCells(xlCellTypeBlanks).Select       
End Sub

5 端點(diǎn)單元格

 Sub d5()   
       Range("a65536").End(xlUp).Offset(1, 0) = 1000     
 End Sub

 Sub d6()   
       Range(Range("b6"), Range("b6").End(xlToRight)).Select     
 End Sub

三势腮、單元格信息

1 單元格的值

 Sub x1()
        Range("b10") = Range("c2").Value
        Range("b11") = Range("c2").Text
      Range("c10") = "" & Range("I3").Formula
 End Sub

2 單元格的地址

Sub x2()
 With Range("b2").CurrentRegion
   [b12] = .Address
   [c12] = .Address(0, 0)
   [d12] = .Address(1, 0)
   [e12] = .Address(0, 1)
   [f12] = .Address(1, 1)
 End With
End Sub

3 單元格的行列信息

Sub x3()
  With Range("b2").CurrentRegion
    [b13] = .Row
    [b14] = .Rows.Count
    [b15] = .Column
    [b16] = .Columns.Count
    [b17] = .Range("a1").Address
  End With
End Sub

4、單元格的格式信息

Sub x4()
  With Range("b2")
    [b19] = .Font.Size
    [b20] = .Font.ColorIndex
    [b21] = .Interior.ColorIndex
    [b22] = .Borders.LineStyle
  End With
End Sub

5阔涉、單元格批注信息

 Sub x5()
    [B24] = Range("I2").Comment.Text
 End Sub

6 單元格的位置信息

 Sub x6()
    With Range("b3")
      [b26] = .Top
      [b27] = .Left
      [b28] = .Height
      [b29] = .Width
    End With
 End Sub

7 單元格的上級(jí)信息

Sub x7()
  With Range("b3")
    [b31] = .Parent.Name
    [b32] = .Parent.Parent.Name
  End With
End Sub

8 內(nèi)容判斷

  Sub x8()
   With Range("i3")
    [b34] = .HasFormula
    [b35] = .Hyperlinks.Count
   End With
  End Sub

四、單元格的數(shù)字格式

1.判斷數(shù)值的格式

（1）判斷是否為空單元格

Sub d1()
   [b1] = ""
   If Range("a1") = "" Then
   If Len([a1]) = 0 Then
   If VBA.IsEmpty([a1]) Then
      [b1] = "空值"
    End If
End Sub

（2）判斷是否為數(shù)字

Sub d2()
  [b2] = ""
  If VBA.IsNumeric([a2]) And [a2] <> "" Then
  If Application.WorksheetFunction.IsNumber([a2]) Then
    [b2] = "數(shù)字"
  End If
End Sub

（3）判斷是否為文本

Sub d3()
  [b3] = ""
  If Application.WorksheetFunction.IsText([A3]) Then
   If VBA.TypeName([a3].Value) = "String" Then
     [b3] = "文本"
  End If
End Sub

（4）判斷是否為漢字

 Sub d4()
    [b4] = ""
    If [a4] > "z" Then
      [b4] = "漢字"
    End If
 End Sub

（5）判斷錯(cuò)誤值

Sub d10()
  [b5] = ""
  If VBA.IsError([a5]) Then
  If Application.WorksheetFunction.IsError([a5]) Then
     [b5] = "錯(cuò)誤值"
  End If
End Sub
 Sub d11()
  [b6] = ""
  If VBA.IsDate([a6]) Then
     [b6] = "日期"
  End If
End Sub

2.設(shè)置單元格自定義格式

 Sub d30()
    Range("d1:d8").NumberFormatLocal = "0.00"
 End Sub

3.按指定格式從單元格返回?cái)?shù)值

Format函數(shù)語(yǔ)法(和工作表數(shù)Text用法基本一致)

Format(數(shù)值,自定義格式代碼)

五跑芳、設(shè)置Excel中的顏色

Excel中的顏色可以用兩種方式獲取默穴，一種是EXCEL內(nèi)置顏色，另一種是利用QBCOLOR函數(shù)返回

Sub y1()
     Dim x As Integer
    Range("a1:b60").Clear
    For x = 1 To 56
          Range("a" & x) = x
          Range("b" & x).Font.ColorIndex = 3
    Next x
End Sub

 Sub y2()
      Dim x As Integer
     For x = 0 To 15
        Range("d" & x + 1) = x
        Range("e" & x + 1).Interior.Color = QBColor(x)
     Next x
 End Sub

Sub y3()
      Dim 紅 As Integer, 綠 As Integer, 藍(lán) As Integer
              紅 = 255
              綠 = 123
              藍(lán) = 100
      Range("g1").Interior.Color = RGB(紅, 綠, 藍(lán))
End Sub

六刮便、單元格合并

1.單元格合并

Sub h1()    
      Range("g1:h3").Merge    
End Sub

2.合并區(qū)域的返回信息

Sub h2()   
     Range("e1") = Range("b3").MergeArea.Address         ' 返回單元格所在的合并單元格區(qū)域   
End Sub

3.判斷是否含合并單元格

Sub h3()
     MsgBox Range("b2").MergeCells
     MsgBox Range("A1:D7").MergeCells
    Range("e2") = IsNull(Range("a1:d7").MergeCells)
    Range("e3") = IsNull(Range("a9:d72").MergeCells)
End Sub

4.綜合示例

合并H列相同單元格

 Sub h4()
  Dim x As Integer
  Dim rg As Range
  Set rg = Range("h1")
   Application.DisplayAlerts = False
  For x = 1 To 13
    If Range("h" & x + 1) = Range("h" & x) Then
      Set rg = Union(rg, Range("h" & x + 1))
    Else
     
       rg.Merge
      
      Set rg = Range("h" & x + 1)
    End If
  Next x
  Application.DisplayAlerts = True
 End Sub

七空猜、單元格輸入

1 單元格輸入

Sub t1()
  Range("a1") = "a" & "b"
  Range("b1") = "a" & Chr(10) & "b"          換行答輸入
End Sub

2 單元格復(fù)制和剪切

  Sub t2()
    Range("a1:a10").Copy Range("c1")          A1：A10的內(nèi)容復(fù)制到C1
  End Sub

  Sub t3()
    Range("a1:a10").Copy
    ActiveSheet.Paste Range("d1")             粘貼至D1
  End Sub
  
  Sub t4()
    Range("a1:a10").Copy
    Range("e1").PasteSpecial (xlPasteValues)       只粘貼為數(shù)值
  End Sub
  
  Sub t5()
    Range("a1:a10").Cut
    ActiveSheet.Paste Range("f1")                  粘貼到f1
  End Sub

  Sub t6()
    Range("c1:c10").Copy
    Range("a1:a10").PasteSpecial Operation:=xlAdd          選擇粘貼-加
  End Sub
  
  Sub T7()
      Range("G1:G10") = Range("A1:A10").Value
  End Sub

3 填充公式

Sub T8()
  Range("b1") = "=a1*10"
  Range("b1:b10").FillDown                     向下填充公式
End Sub

4.插入行并復(fù)制公式

（1）插入行

Sub c1()
    Rows(4).Insert
End Sub

（2）插入行并復(fù)制公式

Sub c2()                      '插入行并復(fù)制公式
        Rows(4).Insert
        Range("3:4").FillDown
      Range("4:4").SpecialCells(xlCellTypeConstants) = ""
End Sub

（3）如不相同，則插入一行

Sub c3()
      Dim x As Integer
      For x = 2 To 20
      If Cells(x, 3) <> Cells(x + 1, 3) Then
            Rows(x + 1).Insert
        x = x + 1
    End If
  Next x
End Sub

（4）相同部門(mén)插入小計(jì)匯總

Sub c4()
  Dim x As Integer, m1 As Integer, m2 As Integer
  Dim k As Integer
  m1 = 2
  For x = 2 To 1000
      If Cells(x, 1) = "" Then Exit Sub
      If Cells(x, 3) <> Cells(x + 1, 3) Then
          m2 = x
          Rows(x + 1).Insert
          Cells(x + 1, "c") = Cells(x, "c") & " 小計(jì)"
          Cells(x + 1, "h") = "=sum(h" & m1 & ":h" & m2 & ")"
          Cells(x + 1, "h").Resize(1, 4).FillRight
          Cells(x + 1, "i") = ""
          x = x + 1
          m1 = m2 + 2
      End If
 Next x
End Sub

（5）刪除小計(jì)行

Sub dd() 刪除小計(jì)行
     Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

八、單元格查詢(xún)

1 使用循環(huán)查找 (在單元格中查找效率太低)

2 調(diào)用工作表函數(shù)

Sub c1() 判斷是否存在,并查找所在行數(shù)
  Dim hao As Integer
  Dim icount As Integer
  icount = Application.WorksheetFunction.CountIf(Sheets("庫(kù)存明細(xì)表").[b:b], [g3])
  If icount > 0 Then
   MsgBox "該入庫(kù)單號(hào)碼已經(jīng)存在辈毯，請(qǐng)不要重復(fù)錄入"
   MsgBox Application.WorksheetFunction.Match([g3], Sheets("庫(kù)存明細(xì)表").[b:b], 0)
  End If
End Sub

3 使用Find方法

Sub c2()
  Dim r As Integer, r1 As Integer
  Dim icount As Integer
  icount = Application.WorksheetFunction.CountIf(Sheets("庫(kù)存明細(xì)表").[b:b], [g3])
  If icount > 0 Then
   r = Sheets("庫(kù)存明細(xì)表").[b:b].Find(Range("G3"), Lookat:=xlWhole).Row 查找號(hào)碼第一次出現(xiàn)的位置
   r1 = Sheets("庫(kù)存明細(xì)表").[b:b].Find([g3], , , , , xlPrevious).Row
   MsgBox r & ":" & r1
  End If
End Sub

4 返回最下一行非空行的行數(shù)

 Sub c3() 返回最下一行非空行的行數(shù)    
  MsgBox Sheets("庫(kù)存明細(xì)表").Cells.Find("*", , , , , xlPrevious).Row    
 End Sub

5 入庫(kù)單查詢(xún)實(shí)例

Sub 輸入()
      Dim c As Integer   '號(hào)碼在庫(kù)存表中的個(gè)數(shù)
      Dim r As Integer   '入庫(kù)單的數(shù)據(jù)行數(shù)
      Dim cr As Integer  '庫(kù)存明細(xì)表中第一個(gè)空行的行數(shù)
      With Sheets("庫(kù)存明細(xì)表")
      c = Application.CountIf(.[b:b], Range("g3"))
      If c > 0 Then
             MsgBox "該單據(jù)號(hào)碼已經(jīng)存在坝疼！,請(qǐng)不要重復(fù)錄入"
       Exit Sub
      Else
           r = Application.CountIf(Range("b6:b10"), "<>")
           cr = .[b65536].End(xlUp).Row + 1
                   .Cells(cr, 1).Resize(r, 1) = Range("e3")
                   .Cells(cr, 2).Resize(r, 1) = Range("g3")
                   .Cells(cr, 3).Resize(r, 1) = Range("c3")
                   .Cells(cr, 4).Resize(r, 6) = Cells(6, 2).Resize(r, 6).Value
           MsgBox "輸入已完成"
      End If
     End With
End Sub


Sub 查找()
      Dim c As Integer   '號(hào)碼在庫(kù)存表中的個(gè)數(shù)
      Dim r As Integer   '入庫(kù)單的數(shù)據(jù)行數(shù)  
      With Sheets("庫(kù)存明細(xì)表")
        c = Application.CountIf(.[b:b], Range("g3"))
        If c = 0 Then
               MsgBox "該單據(jù)號(hào)碼不存在！"
         Exit Sub
        Else
         r = .[b:b].Find(Range("g3"), , , , , xlNext).Row
        Range("c3") = .Cells(r, 3)
        Range("e3") = .Cells(r, 1)
        Cells(6, 2).Resize(c, 5) = .Cells(r, 4).Resize(c, 5).Value
       MsgBox "查詢(xún)已完成"
       End If
     End With
End Sub

Sub 刪除()
     Dim c As Integer   '號(hào)碼在庫(kù)存表中的個(gè)數(shù)
    Dim r As Integer   '入庫(kù)單的數(shù)據(jù)行數(shù)  
    With Sheets("庫(kù)存明細(xì)表")
            c = Application.CountIf(.[b:b], Range("g3"))
            If c = 0 Then
                     MsgBox "該單據(jù)號(hào)碼不存在谆沃！"
           Exit Sub
            Else
                  r = .[b:b].Find(Range("g3"), , , , , xlNext).Row
                        .Range(r & ":" & c + r - 1).Delete
                 MsgBox "刪除已完成"
          End If
   End With
 End Sub

Sub 修改()
    Call 刪除
    Call 輸入
End Sub

<br />

CH7 EXCEL事件

單元格發(fā)生變動(dòng)時(shí)提醒
worksheet selectionchange
加入代碼
private sub worksheet.change(byval target as range)
msgbox target.address &"單元格的值被改為"&target.value
<br />

<br />

CH8 數(shù)組

一钝凶、VBA數(shù)組概念

1、什么是VBA數(shù)組呢唁影？

VBA數(shù)組就是儲(chǔ)存一組數(shù)據(jù)的數(shù)據(jù)空間?數(shù)據(jù)類(lèi)型可以數(shù)字,可以是文本,可以是對(duì)象,也可以是VBA數(shù)組.

2 VBA數(shù)組存在形態(tài)

VBA數(shù)組是以變量形式存放的一個(gè)空間,它也有行有列耕陷，也可以是三維空間。

常量數(shù)組
array(1,2)
array(array(1,2,4),array("a","b","c"))
靜態(tài)數(shù)組
x(4) 有5個(gè)位置据沈，編號(hào)從0~4
arr(1 to 10) 有10個(gè)位置哟沫，編號(hào)1~10
arr(1 to 10,1 to 2) 10行2列的空間，總共20個(gè)位置卓舵，這是二維數(shù)組
arr(1 to 10,1 to 2,1 to 3) 三維數(shù)組南用，總1023=60個(gè)位置膀钠。這是三維數(shù)組
3)動(dòng)態(tài)數(shù)組
arr() 不知道有多少行多少列

二掏湾、數(shù)組的讀取

1.VBA數(shù)組寫(xiě)入

1）按編號(hào)(標(biāo))寫(xiě)入和讀取

 Sub t1()     寫(xiě)入一維數(shù)組
 Dim x As Integer
 Dim arr(1 To 10)
 arr(2) = 190
 arr(10) = 5
 End Sub

Sub t2()     向二維數(shù)組寫(xiě)入數(shù)據(jù)和讀取
 Dim x As Integer, y As Integer
 Dim arr(1 To 5, 1 To 4)
 For x = 1 To 5
   For y = 1 To 4
     arr(x, y) = Cells(x, y)
   Next y
 Next x
MsgBox arr(3, 1)
End Sub

2）動(dòng)態(tài)數(shù)組

   Sub t3()
    Dim arr()
    Dim row
    row = Sheets("sheet2").Range("a65536").End(xlUp).row - 1
    ReDim arr(1 To row)
    For x = 1 To row
       arr(x) = Cells(x, 1)
    Next x
    Stop
   End Sub

3）批量寫(xiě)入

  Sub t4()     由常量數(shù)組導(dǎo)入
  Dim arr
  arr = Array(1, 2, 3, "a")
  Stop
  End Sub

 Sub t5()     由單元格區(qū)域?qū)?   Dim arr
   arr = Range("a1:d5")
   Stop
 End Sub

2.數(shù)組的讀取

1）在內(nèi)存中讀取
在內(nèi)存中讀取后用于繼續(xù)運(yùn)算，直接用下面的格式
數(shù)組變量(5)
數(shù)組變量(3,2)
例:

    Sub d1()
     Dim arr, arr1()
     Dim x As Integer, k As Integer, m As Integer
     arr = Range("a1:a10")     把單元格區(qū)域?qū)雰?nèi)存數(shù)組中
     m = Application.CountIf(Range("a1:a10"), ">10")     計(jì)算大于10的個(gè)數(shù)
     ReDim arr1(1 To m)
     For x = 1 To 10
       If arr(x, 1) > 10 Then
          k = k + 1
          arr1(k) = arr(x, 1)
       End If
     Next x
    End Sub

2）讀取存入單元格中

  Sub d2()     二維數(shù)組存入單元格
    Dim arr, arr1(1 To 5, 1 To 1)
    Dim x As Integer
    arr = Range("b2:c6")
    For x = 1 To 5
      arr1(x, 1) = arr(x, 1) * arr(x, 2)
    Next x
    Range("d2").Resize(10) = arr1
  End Sub
  
  Sub d3()     一維數(shù)組存入單元格
    Dim arr, arr1(1 To 5)
    Dim x As Integer
    arr = Range("b2:c6")
    For x = 1 To 5
      arr1(x) = arr(x, 1) * arr(x, 2)
    Next x
        Range("a13").Resize(1, 5) = arr1
    Range("d2").Resize(5) = Application.Transpose(arr1)
  End Sub
   
  Sub d4()     數(shù)組部分存入
    Dim arr, arr1(1 To 10000, 1 To 1)
    Dim x As Integer
    arr = Range("b2:c6")
    For x = 1 To 5
      arr1(x, 1) = arr(x, 1) * arr(x, 2)
    Next x
    Range("d2").Resize(5) = arr1
  End Sub

三肿嘲、數(shù)組的空間

1融击、數(shù)組的大小

數(shù)組是用編號(hào)排序的，那么如何獲得一個(gè)數(shù)組的大小呢

Lbound(數(shù)組) 可以獲取數(shù)組的最小下標(biāo)(編號(hào))
Ubound(數(shù)組) 可以獲取數(shù)組的最大上標(biāo)(編號(hào))
Ubound(數(shù)組,1) 可以獲得數(shù)組的行方面(第1維)最大上標(biāo)
Ubound(數(shù)組,2) 可以獲得數(shù)組的列方向(第2維)的最大上標(biāo)

Sub d6()
    Dim arr
    Dim k, m
    arr = Range("a2:d5")
    For x = 1 To UBound(arr, 1)

    Next x
End Sub

2雳窟、動(dòng)態(tài)數(shù)組的動(dòng)態(tài)擴(kuò)充

如果一個(gè)數(shù)組無(wú)法或不方便計(jì)算出總的大小尊浪，而在一些特殊情況下又不允許有空位。這時(shí)我們就需要用動(dòng)態(tài)的導(dǎo)入方法

ReDim Preserve arr() 可以聲明一個(gè)動(dòng)態(tài)大小的數(shù)組封救，而且可以保留原來(lái)的數(shù)值拇涤，就相當(dāng)于廠房小了，可以改擴(kuò)建增大誉结，但是它只能讓最未維實(shí)現(xiàn)動(dòng)態(tài)鹅士，如果是一維不存在最未維，只有一維

 （1）擴(kuò)充方式1
Sub d7()
Dim arr, arr1()
 arr = Range("a1:d6")
 Dim x, k
 For x = 1 To UBound(arr)
  If arr(x, 1) = "B" Then
     k = k + 1
     ReDim Preserve arr1(1 To 4, 1 To k)
     arr1(1, k) = arr(x, 1)
     arr1(2, k) = arr(x, 2)
     arr1(3, k) = arr(x, 3)
     arr1(4, k) = arr(x, 4)
  End If
 Next x
Range("a8").Resize(k, 4) = Application.Transpose(arr1)
End Sub

（2）方式二：申明足夠大的數(shù)組
Sub d8()
Dim arr, arr1(1 To 100000, 1 To 4)
arr = Range("a1:d6")
Dim x, k
For x = 1 To UBound(arr)
If arr(x, 1) = "B" Then
k = k + 1
arr1(k, 1) = arr(x, 1)
arr1(k, 2) = arr(x, 2)
arr1(k, 3) = arr(x, 3)
arr1(k, 4) = arr(x, 4)
End If
Next x
Range("a15").Resize(k, 4) = arr1
End Sub

3 清空數(shù)組

清空數(shù)組使用erase語(yǔ)句

Sub d9()
Dim arr, arr1(1 To 1000, 1 To 1)
Dim x, m, k
arr = Range("a1:a16")
For x = 1 To UBound(arr)
 If arr(x, 1) <> "" Then
    k = k + 1
    arr1(k, 1) = arr(x, 1)
 Else
    m = m + 1
    Range("c1").Offset(0, m).Resize(k) = arr1
    Erase arr1
    k = 0
 End If
Next x
End Sub

四惩坑、可以生成數(shù)組的函數(shù)

1掉盅、split函數(shù)

按分隔符把字符串截取成VBA數(shù)組,該數(shù)組是一維數(shù)組，編號(hào)從0開(kāi)始

split(字符串,分隔符)

Sub t1()
  Dim sr, arr
  sr = "A-BC-FGR-H"
  arr = VBA.Split(sr, "-")
  MsgBox Join(arr, ",")
End Sub

2以舒、Filter函數(shù)：只能模糊匹配

按條件篩選符合條件的值組成一個(gè)新的數(shù)組

Filter(數(shù)組,篩選條件,是/否)

注：如果是（true）則返回包含的數(shù)組趾痘，如果否則返回非包含的數(shù)組

Sub t2()
 Dim arr, arr1, arr2
 arr = Application.Transpose(Range("A2:A10"))
 arr1 = VBA.Filter(arr, "W", True)
 arr2 = VBA.Filter(arr, "W", False)
 Range("B2").Resize(UBound(arr1) + 1) = Application.Transpose(arr1)
 Range("C2").Resize(UBound(arr2) + 1) = Application.Transpose(arr2)
End Sub

3、index函數(shù)：

調(diào)用該工作表函數(shù)可以把二維數(shù)組的某一列或某一行截取出來(lái)蔓钟，構(gòu)成一個(gè)新的數(shù)組永票。
Application.Index(二維數(shù)組,0,列數(shù))) 返回二維數(shù)組
Application.Index(二維數(shù)組,行數(shù),0)) 返回一維數(shù)組

Sub t3()
 Dim arr, arr1, arr2
  arr = Range("a2:d6")
  arr1 = Application.Index(arr, , 1)
  arr2 = Application.Index(arr, 4, 0)
  Stop
End Sub

4、vlookup函數(shù)

Vlookup函數(shù)的第一個(gè)參數(shù)可以用VBA數(shù)組，返回的也是一個(gè)VBA數(shù)組

Sub t4()
Dim arr, arr1
  arr = Range("a2:d6")
  arr1 = Application.VLookup(Array("B", "C"), arr, 4, 0)
End Sub

5 Sumif函數(shù)和Countif函數(shù)

Countif和sumif函數(shù)的第二個(gè)參數(shù)都可以使用數(shù)組瓦侮，所以也可以返回一個(gè)VBA數(shù)組艰赞，如：

 Sub t5()
 Dim T
 T = Timer
   Dim arr
   arr = Application.SumIf(Range("a2:a10000"), Array("B", "C", "G", "R"), Range("B2:B10000"))
 MsgBox Timer - T
 Stop
 End Sub

Sub t55()
 Dim T
 T = Timer
  Dim arr, arr1(1 To 4, 1 To 2), x
  arr1(1, 1) = "B"
  arr1(2, 1) = "C"
  arr1(3, 1) = "G"
  arr1(4, 1) = "R"
 
  For x = 2 To 10000
     Select Case Cells(x, 1)
     Case "B"
        arr1(1, 2) = arr1(1, 2) + Cells(x, 2)
     Case "C"
        arr1(2, 2) = arr1(2, 2) + Cells(x, 2)
     Case "G"
        arr1(3, 2) = arr1(3, 2) + Cells(x, 2)
     Case "R"
        arr1(4, 2) = arr1(4, 2) + Cells(x, 2)
     End Select
  Next x
 MsgBox Timer - T
End Sub

五、單元格格式

1.金額大于500填上紅色

Sub 單元格循環(huán)()
Dim x As Integer
Dim t
清除顏色
t = Timer
For x = 2 To Range("a65536").End(xlUp).Row
    If Range("d" & x) > 500 Then
       Range(Cells(x, 1), Cells(x, 4)).Interior.ColorIndex = 3
   End If
Next x
MsgBox Timer - t
End Sub

2.清除顏色

Sub 清除顏色()
  Range("a:d").Interior.ColorIndex = xlNone
End Sub

3.數(shù)組方法1

Sub 數(shù)組方法()
 Dim arr, t
 Dim x As Integer
 Dim sr As String, sr1 As String
 清除顏色
  t = Timer
  arr = Range("d2:d" & Range("a65536").End(xlUp).Row)
 For x = 1 To UBound(arr)
      If x = UBound(arr) And sr <> "" Then Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 3
          If arr(x, 1) > 500 Then
              sr1 = sr
              sr = sr & "A" & x + 1 & ":D" & x + 1 & ","
         If Len(sr) > 255 Then
                sr = sr1
                Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 3
                 sr = ""
        End If
   End If
 Next x
MsgBox Timer - t
End Sub

4.數(shù)組方法2

Sub 數(shù)組方法2()
Dim arr, t
Dim x As Integer, x1 As Integer
Dim sr As String, sr1 As String
清除顏色
t = Timer
arr = Range("d2:d" & Range("a65536").End(xlUp).Row)
For x = 1 To UBound(arr)
      If x = UBound(arr) Then Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 3
           If arr(x, 1) > 500 Then
               sr1 = sr
               x1 = x + 1
               Do
                     x = x + 1
               Loop Until arr(x, 1) <= 500      
     sr = sr & "A" & x1 & ":D" & x & ","
  If Len(sr) > 255 Then
    sr = sr1
    x = x1 - 1
    Range(Left(sr, Len(sr) - 1)).Interior.ColorIndex = 3
    sr = ""
  End If
  x = x - 1
End If
Next x
MsgBox Timer - t
End Sub

5.數(shù)組方法3

Sub 數(shù)組方法3()
    Dim arr, t
    Dim x As Integer, x1 As Integer
    Dim sr As String, sr1 As String
   清除顏色
   t = Timer
  arr = Range("d2:d" & Range("a65536").End(xlUp).Row)
  For x = 1 To UBound(arr)
  If x = UBound(arr) Then Application.Intersect(Range("a:d"), Range(Left(sr, Len(sr) - 1))).Interior.ColorIndex = 3
       If arr(x, 1) > 500 Then
        sr1 = sr
       x1 = x + 1
      Do
           x = x + 1
     Loop Until arr(x, 1) <= 500      
     sr = sr & x1 & ":" & x & ","
     If Len(sr) > 255 Then
          sr = sr1
         x = x1 - 1
        Application.Intersect(Range("a:d"), Range(Left(sr, Len(sr) - 1))).Interior.ColorIndex = 3
        sr = ""
     End If
  x = x - 1
 End If
 Next x
 MsgBox Timer - t
End Sub

Option Explicit
'數(shù)組也可以設(shè)置格式肚吏？
'數(shù)組除了數(shù)字類(lèi)型外方妖，當(dāng)然沒(méi)有顏色、字體等格式罚攀，但是別忘了range對(duì)象可以表示多個(gè)連續(xù)或不連續(xù)的單元格區(qū)域
'利用上述特點(diǎn)党觅，我們就是要數(shù)組構(gòu)造單元格地址串，然后批量對(duì)單元格進(jìn)行格式設(shè)置斋泄。
'注意杯瞻，單元格地址串不能>255，所以如果單元格操作過(guò)多炫掐，我們還需要分次分批設(shè)置單元格格式

Sub 填充顏色()
 Range("a2:d2,a7:d7,a10:d10").Interior.ColorIndex = 3
End Sub

六魁莉、數(shù)組函數(shù)補(bǔ)充

1 數(shù)組的最值

 Sub s()
 Dim arr1()
 
arr1 = Array(1, 12, 4, 5, 19)
 
MsgBox "1, 12, 4, 5, 19最大值" & Application.Max(arr1)
 MsgBox "1, 12, 4, 5, 19最小值:" & Application.Min(arr1)
 MsgBox "1, 12, 4, 5, 19第二大值：" & Application.Large(arr1, 2)
 MsgBox "1, 12, 4, 5, 19第二小值：" & Application.Small(arr1, 2)
 
End Sub

2、求和

 用application.Sum (數(shù)組)

3 統(tǒng)計(jì)個(gè)數(shù)

counta和count函數(shù)可以統(tǒng)計(jì)VBA數(shù)組的數(shù)字個(gè)數(shù)及所有已填充內(nèi)容的個(gè)數(shù)

 Sub s1()
  
  Dim arr1, arr2(0 To 10), x
  arr1 = Array("a", "3", "", 4, 6)
  For x = 0 To 4
    arr2(x) = arr1(x)
  Next x
  
  MsgBox "數(shù)組1的數(shù)字個(gè)數(shù)：" & Application.Count(arr2)
  
  MsgBox "數(shù)組2的已填充數(shù)值的個(gè)數(shù)" & Application.CountA(arr2)
  
  End Sub

4 在數(shù)組里查找

  Sub s2()
   Dim arr
   On Error Resume Next
   arr = Array("a", "c", "b", "f", "d")
   MsgBox Application.Match("f", arr, 0)
  If Err.Number = 13 Then
     MsgBox "查找不到"
   End If
  End Sub

二募胃、數(shù)組函數(shù)

1旗唁、split函數(shù)

 '按分隔符把字符串截取成VBA數(shù)組,該數(shù)組是一維數(shù)組，編號(hào)從0開(kāi)始

 'split(字符串,分隔符)

Sub t1()
  Dim sr, arr
  sr = "A-BC-FGR-H"
  arr = VBA.Split(sr, "-")
  MsgBox Join(arr, ",")
End Sub

2痹束、Filter函數(shù)：

 '按條件篩選符合條件的值組成一個(gè)新的數(shù)組

 'Filter(數(shù)組,篩選條件,是/否)
 
 '注：如果是（true）則返回包含的數(shù)組检疫，如果否則返回非包含的數(shù)組
Sub t2()
 Dim arr, arr1, arr2
 arr = Application.Transpose(Range("A2:A10"))
 arr1 = VBA.Filter(arr, "W", True)
 arr2 = VBA.Filter(arr, "W", False)
 Range("B2").Resize(UBound(arr1) + 1) = Application.Transpose(arr1)
 Range("C2").Resize(UBound(arr2) + 1) = Application.Transpose(arr2)
End Sub

3、index函數(shù)：

'調(diào)用該工作表函數(shù)可以把二維數(shù)組的某一列或某一行截取出來(lái)祷嘶，構(gòu)成一個(gè)新的數(shù)組屎媳。

' Application.Index(二維數(shù)組,0,列數(shù))) 返回二維數(shù)組
  ' Application.Index(二維數(shù)組,行數(shù),0)) 返回一維數(shù)組
 Sub t3()
  Dim arr, arr1, arr2

   arr = Range("a2:d6")
   arr1 = Application.Index(arr, , 1)
   arr2 = Application.Index(arr, 4, 0)
   Stop
 End Sub

4、vlookup函數(shù)

  'Vlookup函數(shù)的第一個(gè)參數(shù)可以用VBA數(shù)組论巍，返回的也是一個(gè)VBA數(shù)組

    Sub t4()
    Dim arr, arr1
      arr = Range("a2:d6")
      arr1 = Application.VLookup(Array("B", "C"), arr, 4, 0)
    End Sub

5 Sumif函數(shù)和Countif函數(shù)

 'Countif和sumif函數(shù)的第二個(gè)參數(shù)都可以使用數(shù)組烛谊，所以也可以返回一個(gè)VBA數(shù)組，如：

 Sub t5()
     Dim T
     T = Timer
       Dim arr
       arr = Application.SumIf(Range("a2:a10000"), Array("B", "C", "G", "R"), Range("B2:B10000"))
     MsgBox Timer - T
     Stop
     End Sub

   Sub t55()
     Dim T
     T = Timer
      Dim arr, arr1(1 To 4, 1 To 2), x
      arr1(1, 1) = "B"
      arr1(2, 1) = "C"
      arr1(3, 1) = "G"
      arr1(4, 1) = "R"
     ' arr = Range("a1:d10000")
      For x = 2 To 10000
         Select Case Cells(x, 1)
         Case "B"
            arr1(1, 2) = arr1(1, 2) + Cells(x, 2)
         Case "C"
            arr1(2, 2) = arr1(2, 2) + Cells(x, 2)
         Case "G"
            arr1(3, 2) = arr1(3, 2) + Cells(x, 2)
         Case "R"
            arr1(4, 2) = arr1(4, 2) + Cells(x, 2)
         End Select
      Next x
     MsgBox Timer - T
   End Sub

七嘉汰、VBA排序算法

1.插入排序

Sub 插入排序()
Dim arr, temp, x, y, t, iMax, k, k1, k2
     t = Timer
    arr = Range("a1:a10")
    For x = 1 + 1 To UBound(arr)  
    temp = arr(x, 1)     記得要插入的值     
    For y = x - 1 To 1 Step -1
   If arr(y, 1) <= temp Then Exit For
   arr(y + 1, 1) = arr(y, 1)
       k1 = k1 + 1
   Next y
   arr(y + 1, 1) = temp
         k2 = k2 + 1
  Next
     Range("d3").Resize(UBound(arr)) = ""
     Range("d3").Resize(UBound(arr)) = arr
     Range("d2") = Timer - t
     MsgBox k1
End Sub

Sub 插入排序單元格演示()
     On Error Resume Next
    Dim arr, temp, x, y, t, iMax, k
    For x = 2 To 10  
        temp = Cells(x, 1)     記得要插入的值
                 Range("A" & x).Interior.ColorIndex = 3
       For y = x - 1 To 1 Step -1
               Range("A" & y).Interior.ColorIndex = 4
        If Cells(y, 1) <= temp Then Exit For
               Cells(y + 1, 1) = Cells(y, 1)
               Range("A" & y).Interior.ColorIndex = xlNone
       Next y
       Cells(y + 1, 1) = temp
           Range("A" & y).Interior.ColorIndex = xlNone
           Range("A" & x).Interior.ColorIndex = xlNone
   Next
End Sub

2.快速排序

Sub dd()
Dim arr1(0 To 4999) As Long, arr, x, t
t = Timer
arr = Range("a1:a5000")
For x = 1 To 5000
  arr1(x - 1) = arr(x, 1)
Next x
QuickSort arr1()
Range("f2") = Timer - t
 End Sub 

Public Sub QuickSort(ByRef lngArray() As Long)
    Dim iLBound As Long
    Dim iUBound As Long
    Dim iTemp As Long
    Dim iOuter As Long
    Dim iMax As Long
             iLBound = LBound(lngArray)
            iUBound = UBound(lngArray)     
            If (iUBound - iLBound) Then
                For iOuter = iLBound To iUBound   
            If lngArray(iOuter) > lngArray(iMax) Then iMax = iOuter
                  Next iOuter
                   iTemp = lngArray(iMax)
                  lngArray(iMax) = lngArray(iUBound)
                  lngArray(iUBound) = iTemp            開(kāi)始快速排序
                  InnerQuickSort lngArray, iLBound, iUBound
            End If
        R ange("f3").Resize(5000) = Application.Transpose(lngArray)
    End Sub



Private Sub InnerQuickSort(ByRef lngArray() As Long, ByVal iLeftEnd As Long, ByVal iRightEnd As Long)

Dim iLeftCur As Long

Dim iRightCur As Long

Dim iPivot As Long

Dim iTemp As Long



If iLeftEnd >= iRightEnd Then Exit Sub



iLeftCur = iLeftEnd

iRightCur = iRightEnd + 1

iPivot = lngArray(iLeftEnd)  

Do
    Do
        iLeftCur = iLeftCur + 1
    Loop While lngArray(iLeftCur) < iPivot       

    Do

        iRightCur = iRightCur - 1
    Loop While lngArray(iRightCur) > iPivot       

    If iLeftCur >= iRightCur Then Exit Do              
   交換值
    iTemp = lngArray(iLeftCur)
    lngArray(iLeftCur) = lngArray(iRightCur)
    lngArray(iRightCur) = iTemp
Loop  

    遞歸快速排序
lngArray(iLeftEnd) = lngArray(iRightCur)
lngArray(iRightCur) = iPivot
InnerQuickSort lngArray, iLeftEnd, iRightCur - 1
InnerQuickSort lngArray, iRightCur + 1, iRightEnd
End Sub

3.冒泡排序

Sub 冒泡排序()
   Dim arr, temp, x, y, t, k
   t = Timer
   arr = Range("a1:a10")
   For x = 1 To UBound(arr) - 1
         For y = x + 1 To UBound(arr)     只和當(dāng)前數(shù)字下面的數(shù)進(jìn)行比較
             If arr(x, 1) > arr(y, 1) Then     如果它大于它下面某一個(gè)數(shù)字
                     temp = arr(x, 1)
                     arr(x, 1) = arr(y, 1)
                     arr(y, 1) = temp
             End If
   
         Next y
     Next x
     Range("b3").Resize(x) = ""
     Range("b3").Resize(x) = arr
             Range("b2") = Timer - t
     MsgBox k
End Sub


Sub 冒泡排序演示()
     Dim arr, temp, x, y, t, k
     For x = 1 To 9
                Range("a" & x).Interior.ColorIndex = 3
     For y = x + 1 To 10      只和當(dāng)前數(shù)字下面的數(shù)進(jìn)行比較
                     Range("a" & y).Interior.ColorIndex = 4
     If Cells(x, 1) > Cells(y, 1) Then     如果它大于它下面某一個(gè)數(shù)字
           temp = Cells(x, 1)
           Cells(x, 1) = Cells(y, 1)
           Cells(y, 1) = temp
     End If
                     Range("a" & y).Interior.ColorIndex = xlNone
     Next y
                     Range("a" & x).Interior.ColorIndex = xlNone                         
     Next x
End Sub

4.希爾排序

Sub 希爾排序()
    Dim arr
    Dim 總大小, 間隔, x, y, temp, t
    t = Timer
    arr = Range("a1:a30")
    總大小 = UBound(arr) - LBound(arr) + 1
    間隔 = 1
    If 總大小 > 13 Then
             Do While 間隔 < 總大小
                   間隔 = 間隔 * 3 + 1
             Loop
             間隔 = 間隔 \ 9
    End If
      Stop
    Do While 間隔
           For x = LBound(arr) + 間隔 To UBound(arr)
            temp = arr(x, 1)
          For y = x - 間隔 To LBound(arr) Step -間隔
                     If arr(y, 1) <= temp Then Exit For
                       arr(y + 間隔, 1) = arr(y, 1)
                               k1 = k1 + 1
          Next y
                  arr(y + 間隔, 1) = temp
                   Next x
                  間隔 = 間隔 \ 3
           Loop
                   MsgBox k1
                   Range("e3").Resize(5000) = ""
                  Range("d1").Resize(UBound(arr)) = arr
                           Range("e2") = Timer - t
  End Sub
Sub 打亂順序()
     Dim arr, temp, x
     arr = Range("a1:a" & Range("a65536").End(xlUp).Row)
     For x = 1 To UBound(arr)
           num = Int(Rnd() * UBound(arr) + 1)
           temp = arr(num, 1)
           arr(num, 1) = arr(x, 1)
           arr(x, 1) = temp
     Next x
     Range("a1").Resize(x - 1) = arr
 End Sub
     Sub 希爾排序單元格演示()
       Dim arr
       Dim 總大小, 間隔, x, y, temp, t
       t = Timer
       arr = Range("a1:a" & Range("a65536").End(xlUp).Row)
       總大小 = UBound(arr) - LBound(arr) + 1
       間隔 = 1
       If 總大小 > 13 Then
          Do While 間隔 < 總大小
            間隔 = 間隔 * 3 + 1
          Loop
          間隔 = 間隔 \ 9
       End If
           Stop
       Do While 間隔
          For x = LBound(arr) + 間隔 To UBound(arr)
           temp = Cells(x, 1)
           Range("a" & x).Interior.ColorIndex = 3
           For y = x - 間隔 To LBound(arr) Step -間隔
               Range("a" & y).Interior.ColorIndex = 6
              If Cells(y, 1) <= temp Then Exit For
              Cells(y + 間隔, 1) = Cells(y, 1)
                  k1 = k1 + 1
           Next y
           Cells(y + 間隔, 1) = temp
           Range("a1:a30").Interior.ColorIndex = xlNone
          Next x
         間隔 = 間隔 \ 3
        Loop
            MsgBox k1
            Range("e3").Resize(5000) = ""
             Range("d1").Resize(UBound(arr)) = arr
            Range("e2") = Timer - t
     End Sub

5.選擇排序

     Sub 選擇排序()
       Dim arr, temp, x, y, t, iMax, k, k1, k2
       t = Timer
       arr = Range("a1:a10")
       For x = UBound(arr) To 1 + 1 Step -1
          iMax = 1     最大的索引
          For y = 1 To x
               If arr(y, 1) > arr(iMax, 1) Then iMax = y
          Next y
          temp = arr(iMax, 1)
          arr(iMax, 1) = arr(x, 1)
          arr(x, 1) = temp
       Next x  
           Range("c3").Resize(UBound(arr)) = ""
           Range("c3").Resize(UBound(arr)) = arr
           Range("c2") = Timer - t
           MsgBox k1
     End Sub

     Sub 選擇排序單元格演示()
       Dim arr, temp, x, y, t, iMax, k, k1, k2
       For x = 10 To 2 Step -1
          iMax = 1
                            Range("a" & x).Interior.ColorIndex = 3
          For y = 1 To x
                            Range("a" & y).Interior.ColorIndex = 4
               If Cells(y, 1) > Cells(iMax, 1) Then
                            Range("a" & iMax).Interior.ColorIndex = xlNone
                iMax = y
               End If
                            Range("a" & y).Interior.ColorIndex = xlNone
                            Range("a" & iMax).Interior.ColorIndex = 6                       
          Next y
          temp = Cells(iMax, 1)
          Cells(iMax, 1) = Cells(x, 1)
          Cells(x, 1) = temp
          Range("a" & x).Interior.ColorIndex = xlNone
          Range("a" & iMax).Interior.ColorIndex = xlNone
       Next x
     End Sub

<br />

CH9 VBA字典

一丹禀、基本概念

1 什么是VBA字典？
字典（dictionary）是一個(gè)儲(chǔ)存數(shù)據(jù)的小倉(cāng)庫(kù)郑现。共有兩列湃崩。
第一列叫key , 不允許有重復(fù)的元素。
第二列是item,每一個(gè)key對(duì)應(yīng)一個(gè)item接箫，本列允許為重復(fù)
Key item
A 10
B 20
C 30
Z 10

2 即然有數(shù)組攒读，為什么還要學(xué)字典？
原因:提速辛友，具體表現(xiàn)在
1) A列只能裝入非重復(fù)的元素薄扁，利用這個(gè)特點(diǎn)可以很方便的提取不重復(fù)的值
2) 每一個(gè)key對(duì)應(yīng)一個(gè)唯一的item剪返，只要指點(diǎn)key的值，就可以馬上返回其對(duì)應(yīng)的item邓梅，利用字典可以實(shí)現(xiàn)快速的查找

3 字典有什么局限脱盲？
字典只有兩列，如果要處理多列的數(shù)據(jù)日缨，還需要通過(guò)字符串的組合和拆分來(lái)實(shí)現(xiàn)钱反。
字典調(diào)用會(huì)耗費(fèi)一定時(shí)間，如果是數(shù)據(jù)量不大匣距，字典的優(yōu)勢(shì)就無(wú)法體現(xiàn)出來(lái)面哥。

4 字典在哪里？如何創(chuàng)建字典毅待？
字典是由scrrun.dll鏈接庫(kù)提供的尚卫，要調(diào)用字典有兩種方法
第一種方法：直接創(chuàng)建法
Set d = CreateObject("scripting.dictionary")
第二種方法：引用法
工具-引用-瀏覽-找到scrrun.dll-確定

二、VBA字典的使用

1 裝入數(shù)據(jù)

Sub t1()
  Dim d As New Dictionary
  Dim x As Integer
  For x = 2 To 4
   d.Add Cells(x, 1).Value, Cells(x, 2).Value
  Next x
  MsgBox d.Keys(1)
      Stop
End Sub

2 讀取數(shù)據(jù)

Sub t2()
  Dim d
  Dim arr
  Dim x As Integer
  Set d = CreateObject("scripting.dictionary")
  For x = 2 To 4
   d.Add Cells(x, 1).Value, Cells(x, 2).Value
  Next x
      MsgBox d("李四")
      MsgBox d.Keys(2)
  Range("d1").Resize(d.Count) = Application.Transpose(d.Keys)
  Range("e1").Resize(d.Count) = Application.Transpose(d.Items)
  arr = d.Items
End Sub

3 修改數(shù)據(jù)

Sub t3()
  Dim d As New Dictionary
  Dim x As Integer
  For x = 2 To 4
   d.Add Cells(x, 1).Value, Cells(x, 2).Value
  Next x
  d("李四") = 78
  MsgBox d("李四")
  d("趙六") = 100
  MsgBox d("趙六")
End Sub

4 刪除數(shù)據(jù)

Sub t4()
  Dim d As New Dictionary
  Dim x As Integer
  For x = 2 To 4
    d(Cells(x, 1).Value) = Cells(x, 2).Value
  Next x
   d.Remove "李四"
      MsgBox d.Exists("李四")
  d.RemoveAll
  MsgBox d.Count
End Sub

5.區(qū)分大小寫(xiě)

Sub t5()
  Dim d As New Dictionary
  Dim x
  For x = 1 To 5
    d(Cells(x, 1).Value) = ""
  Next x
  Stop
End Sub

三尸红、字典與查找

     Sub 多表雙向查找()
      Dim d As New Dictionary
      Dim x, y
      Dim arr
      For x = 3 To 5
        arr = Sheets(x).Range("a2").Resize(Sheets(x).Range("a65536").End(xlUp).Row - 1, 2)
        For y = 1 To UBound(arr)
          d(arr(y, 1)) = arr(y, 2)
          d(arr(y, 2)) = arr(y, 1)
        Next y
      Next x
      MsgBox d("C1")
      MsgBox d("吳情")
     End Sub

四吱涉、字典與求和

      Dim d As New Dictionary
      Dim arr, x
      arr = Range("a2:b10")
      For x = 1 To UBound(arr)
        d(arr(x, 1)) = d(arr(x, 1)) + arr(x, 2) 'key對(duì)應(yīng)的item的值在原來(lái)的基礎(chǔ)上加新的
      Next x
      Range("d2").Resize(d.Count) = Application.Transpose(d.Keys)
      Range("e2").Resize(d.Count) = Application.Transpose(d.Items)
     End Sub

五、字典與唯一值

     Sub 提取不重復(fù)的產(chǎn)品()
      Dim d As New Dictionary
      Dim arr, x
      arr = Range("a2:a12")
      For x = 1 To UBound(arr)
           d(arr(x, 1)) = ""
      Next x
      Range("c2").Resize(d.Count) = Application.Transpose(d.Keys)
     End Sub

六外里、字典綜合算法

1.多列匯總

     Sub 下棋法之多列匯總()
      Dim 棋盤(pán)(1 To 10000, 1 To 3)
      Dim 行數(shù)
      Dim arr, x, k
      Dim d As New Dictionary
      arr = Range("a2:c" & Range("a65536").End(xlUp).Row)
      For x = 1 To UBound(arr)
        If d.Exists(arr(x, 1)) Then
           行數(shù) = d(arr(x, 1))
           棋盤(pán)(行數(shù), 2) = 棋盤(pán)(行數(shù), 2) + arr(x, 2)
           棋盤(pán)(行數(shù), 3) = 棋盤(pán)(行數(shù), 3) + arr(x, 3)
        Else
           k = k + 1
           d(arr(x, 1)) = k
           棋盤(pán)(k, 1) = arr(x, 1)
           棋盤(pán)(k, 2) = arr(x, 2)
           棋盤(pán)(k, 3) = arr(x, 3)
        End If
      Next x
      Range("f2").Resize(k, 3) = 棋盤(pán)
     End Sub

2.多條件多列匯總

     Sub 下棋法之多條件多列匯總()
      Dim 棋盤(pán)(1 To 10000, 1 To 4)
      Dim 行數(shù)
      Dim arr, x As Integer, sr As String, k As Integer
      Dim d As New Dictionary
      arr = Range("a2:d" & Range("a65536").End(xlUp).Row)
      For x = 1 To UBound(arr)
         sr = arr(x, 1) & "-" & arr(x, 2)
         If d.Exists(sr) Then
           行數(shù) = d(sr)
           棋盤(pán)(行數(shù), 3) = 棋盤(pán)(行數(shù), 3) + arr(x, 3)
           棋盤(pán)(行數(shù), 4) = 棋盤(pán)(行數(shù), 4) + arr(x, 4)
         Else
           k = k + 1
           d(sr) = k
           棋盤(pán)(k, 1) = arr(x, 1)
           棋盤(pán)(k, 2) = arr(x, 2)
           棋盤(pán)(k, 3) = arr(x, 3)
           棋盤(pán)(k, 4) = arr(x, 4)
         End If
      Next x
        Range("g2").Resize(k, 4) = 棋盤(pán)
     End Sub

3.數(shù)據(jù)透視表式匯總

     Sub 下棋法之?dāng)?shù)據(jù)透視表式匯總()
      Dim d As New Dictionary
      Dim 棋盤(pán)(1 To 10000, 1 To 7)
      Dim 行數(shù), 列數(shù)
      Dim arr, x, k 
      arr = Range("a2:c" & Range("a65536").End(xlUp).Row) 
      For x = 1 To UBound(arr)
        列數(shù) = (InStr("1月2月3月4月5月6月", arr(x, 2)) + 1) / 2 + 1
        If d.Exists(arr(x, 1)) Then
           行數(shù) = d(arr(x, 1))      
           棋盤(pán)(行數(shù), 列數(shù)) = 棋盤(pán)(行數(shù), 列數(shù)) + arr(x, 3)
        Else
           k = k + 1
           d(arr(x, 1)) = k
           棋盤(pán)(k, 1) = arr(x, 1)
           棋盤(pán)(k, 列數(shù)) = arr(x, 3)
        End If
      Next x 
      Range("f2").Resize(k, 7) = 棋盤(pán)
     End Sub

最后編輯于：2018.11.30 14:51:18

?著作權(quán)歸作者所有,轉(zhuǎn)載或內(nèi)容合作請(qǐng)聯(lián)系作者

人面猴
序言：七十年代末怎爵，一起剝皮案震驚了整個(gè)濱河市，隨后出現(xiàn)的幾起案子级乐，更是在濱河造成了極大的恐慌疙咸，老刑警劉巖县匠，帶你破解...
沈念sama閱讀 206,311評(píng)論 6贊 481
死咒
序言：濱河連續(xù)發(fā)生了三起死亡事件风科，死亡現(xiàn)場(chǎng)離奇詭異，居然都是意外死亡乞旦，警方通過(guò)查閱死者的電腦和手機(jī)贼穆，發(fā)現(xiàn)死者居然都...
沈念sama閱讀 88,339評(píng)論 2贊 382
救了他兩次的神仙讓他今天三更去死
文/潘曉璐我一進(jìn)店門(mén)，熙熙樓的掌柜王于貴愁眉苦臉地迎上來(lái)兰粉，“玉大人故痊，你說(shuō)我怎么就攤上這事【凉茫” “怎么了愕秫？”我有些...
開(kāi)封第一講書(shū)人閱讀 152,671評(píng)論 0贊 342
道士緝兇錄：失蹤的賣(mài)姜人
文/不壞的土叔我叫張陵，是天一觀的道長(zhǎng)焰络。經(jīng)常有香客問(wèn)我戴甩，道長(zhǎng)，這世上最難降的妖魔是什么闪彼？我笑而不...
開(kāi)封第一講書(shū)人閱讀 55,252評(píng)論 1贊 279
?港島之戀（遺憾婚禮）
正文為了忘掉前任甜孤，我火速辦了婚禮，結(jié)果婚禮上，老公的妹妹穿的比我還像新娘缴川。我一直安慰自己茉稠，他們只是感情好，可當(dāng)我...
茶點(diǎn)故事閱讀 64,253評(píng)論 5贊 371
惡毒庶女頂嫁案：這布局不是一般人想出來(lái)的
文/花漫我一把揭開(kāi)白布把夸。她就那樣靜靜地躺著而线，像睡著了一般。火紅的嫁衣襯著肌膚如雪恋日。梳的紋絲不亂的頭發(fā)上吞获，一...
開(kāi)封第一講書(shū)人閱讀 49,031評(píng)論 1贊 285
城市分裂傳說(shuō)
那天，我揣著相機(jī)與錄音谚鄙，去河邊找鬼各拷。笑死，一個(gè)胖子當(dāng)著我的面吹牛闷营，可吹牛的內(nèi)容都是我干的烤黍。我是一名探鬼主播，決...
沈念sama閱讀 38,340評(píng)論 3贊 399
雙鴛鴦連環(huán)套：你想象不到人心有多黑
文/蒼蘭香墨我猛地睜開(kāi)眼傻盟，長(zhǎng)吁一口氣：“原來(lái)是場(chǎng)噩夢(mèng)啊……” “哼速蕊！你這毒婦竟也來(lái)了？” 一聲冷哼從身側(cè)響起娘赴，我...
開(kāi)封第一講書(shū)人閱讀 36,973評(píng)論 0贊 259
萬(wàn)榮殺人案實(shí)錄
序言：老撾萬(wàn)榮一對(duì)情侶失蹤规哲，失蹤者是張志新（化名）和其女友劉穎，沒(méi)想到半個(gè)月后诽表，有當(dāng)?shù)厝嗽跇?shù)林里發(fā)現(xiàn)了一具尸體唉锌，經(jīng)...
沈念sama閱讀 43,466評(píng)論 1贊 300
?護(hù)林員之死
正文獨(dú)居荒郊野嶺守林人離奇死亡，尸身上長(zhǎng)有42處帶血的膿包…… 初始之章·張勛以下內(nèi)容為張勛視角年9月15日...
茶點(diǎn)故事閱讀 35,937評(píng)論 2贊 323
?白月光啟示錄
正文我和宋清朗相戀三年竿奏，在試婚紗的時(shí)候發(fā)現(xiàn)自己被綠了袄简。大學(xué)時(shí)的朋友給我發(fā)了我未婚夫和他白月光在一起吃飯的照片。...
茶點(diǎn)故事閱讀 38,039評(píng)論 1贊 333
活死人
序言：一個(gè)原本活蹦亂跳的男人離奇死亡泛啸，死狀恐怖绿语，靈堂內(nèi)的尸體忽然破棺而出，到底是詐尸還是另有隱情候址，我是刑警寧澤吕粹，帶...
沈念sama閱讀 33,701評(píng)論 4贊 323
?日本核電站爆炸內(nèi)幕
正文年R本政府宣布，位于F島的核電站岗仑，受9級(jí)特大地震影響匹耕，放射性物質(zhì)發(fā)生泄漏。R本人自食惡果不足惜赔蒲，卻給世界環(huán)境...
茶點(diǎn)故事閱讀 39,254評(píng)論 3贊 307
男人毒藥：我在死后第九天來(lái)索命
文/蒙蒙一泌神、第九天我趴在偏房一處隱蔽的房頂上張望良漱。院中可真熱鬧，春花似錦欢际、人聲如沸母市。這莊子的主人今日做“春日...
開(kāi)封第一講書(shū)人閱讀 30,259評(píng)論 0贊 19
一樁弒父案损趋，背后竟有這般陰謀
文/蒼蘭香墨我抬頭看了看天上的太陽(yáng)患久。三九已至，卻和暖如春浑槽，著一層夾襖步出監(jiān)牢的瞬間蒋失，已是汗流浹背。一陣腳步聲響...
開(kāi)封第一講書(shū)人閱讀 31,485評(píng)論 1贊 262
情欲美人皮
我被黑心中介騙來(lái)泰國(guó)打工桐玻，沒(méi)想到剛下飛機(jī)就差點(diǎn)兒被人妖公主榨干…… 1. 我叫王不留篙挽，地道東北人。一個(gè)月前我還...
沈念sama閱讀 45,497評(píng)論 2贊 354
代替公主和親
正文我出身青樓镊靴，卻偏偏與公主長(zhǎng)得像铣卡，于是被迫代替她去往敵國(guó)和親。傳聞我的和親對(duì)象是個(gè)殘疾皇子偏竟，可洞房花燭夜當(dāng)晚...
茶點(diǎn)故事閱讀 42,786評(píng)論 2贊 345

VBA學(xué)習(xí)筆記-02

目錄

CH6 單元格操作

CH7 EXCEL事件

CH8 VBA數(shù)組

CH9 VBA字典

CH6 單元格操作

一刨裆、單元格的選取

1 表示一個(gè)單元格(a1)

2 表示相鄰單元格區(qū)域

3 表示不相鄰的單元格區(qū)域

4 表示行

5 表示列

6 重置坐標(biāo)下的單元格表示方法

7 表示正在選取的單元格區(qū)域

二梗摇、特殊單元格定位

1 已使用的單元格區(qū)域

2 某單元格所在的單元格區(qū)域

3 兩個(gè)單元格區(qū)域共同的區(qū)域

4 調(diào)用定位條件選取特殊單元格

5 端點(diǎn)單元格

三势腮、單元格信息

1 單元格的值

2 單元格的地址

3 單元格的行列信息

4、單元格的格式信息

5阔涉、單元格批注信息

6 單元格的位置信息

7 單元格的上級(jí)信息

8 內(nèi)容判斷

四、單元格的數(shù)字格式

1.判斷數(shù)值的格式

2.設(shè)置單元格自定義格式

3.按指定格式從單元格返回?cái)?shù)值

五跑芳、設(shè)置Excel中的顏色

六刮便、單元格合并

1.單元格合并

2.合并區(qū)域的返回信息

3.判斷是否含合并單元格

4.綜合示例

七空猜、單元格輸入

1 單元格輸入

2 單元格復(fù)制和剪切

3 填充公式

4.插入行并復(fù)制公式

八、單元格查詢(xún)

1 使用循環(huán)查找 (在單元格中查找效率太低)

2 調(diào)用工作表函數(shù)

3 使用Find方法

4 返回最下一行非空行的行數(shù)

5 入庫(kù)單查詢(xún)實(shí)例

CH7 EXCEL事件

CH8 數(shù)組

一钝凶、VBA數(shù)組概念

1、什么是VBA數(shù)組呢唁影？

2 VBA數(shù)組存在形態(tài)

二掏湾、數(shù)組的讀取

1.VBA數(shù)組寫(xiě)入

2.數(shù)組的讀取

三肿嘲、數(shù)組的空間

1融击、數(shù)組的大小

2雳窟、動(dòng)態(tài)數(shù)組的動(dòng)態(tài)擴(kuò)充

3 清空數(shù)組

四惩坑、可以生成數(shù)組的函數(shù)

1掉盅、split函數(shù)

2以舒、Filter函數(shù)：只能模糊匹配

3、index函數(shù)：

4、vlookup函數(shù)

5 Sumif函數(shù)和Countif函數(shù)

五、單元格格式

1.金額大于500填上紅色

2.清除顏色

3.數(shù)組方法1

4.數(shù)組方法2

5.數(shù)組方法3

六魁莉、數(shù)組函數(shù)補(bǔ)充

1 數(shù)組的最值

2、求和

3 統(tǒng)計(jì)個(gè)數(shù)

4 在數(shù)組里查找