全解vba初學者編程代碼大全 vba編程代碼大全 _經驗分享

文章插圖
1單元格合并：
Sub 宏1()
Dim i As Long
For i = 1 To 10
Cells(i, 3) = Cells(i, 1).Value & “-” & Cells(i, 2).Value
Next
End Sub
2. 單元格區域存入VBA數組

文章插圖
Sub 宏1()
Dim arr ‘聲明一個變量
Dim x As Integer
arr = Range(“a1:d10”) ‘確定arr的范圍，也就是我們操作的區域
For x = 1 To 7
arr(x, 4) = arr(x, 3) * arr(x, 2) ‘數組的賦值方法
Next x
Range(“a1:d4”) = arr ‘數組最終的賦值區域，區域不同結果不同，但不能超出前面定義的范圍
End Sub
3一維VBA數組放入單元格區域中

文章插圖
Sub 宏1()
Dim arr(1 To 5) ‘聲明一個變量,固定數組A1到E1
For x = 1 To 5
arr(x) = x * 3 ‘聲明單個單元格的計算方法
Next x
Range(“a1:e1”) = arr ‘把單元格計算的結果賦值給我們選定的數組
Range(“a1:a5”) = Application.Transpose(arr) ‘把我們選定的數組做轉置，出結果A1到A5
End Sub
4提取符合條件的單元格

文章插圖
Sub ggsmart()
Dim i%, xrow%, j%, xcount% ‘定義變量xrow為A列單元格數目，xcount為包含張的個數
Dim arr() As String ‘定義arr為動態數組，由于不確定動態數組的邊界
xrow = [a65536].End(3).Row ‘算出A列最后一個非空單元格行號然后賦值給Xrow
j = 1 ‘數組索引號
xcount =
Application.WorksheetFunction.CountIf([a1:a65536], “張*”) ‘統計有多少姓張的學生賦值給xcount
ReDim arr(1 To xcount) ‘重新定義數組大小，元素共有xcount個，此時xcount已經有值了
For i = 1 To xrow ‘定義i的取值范圍
If Left(Cells(i, 1).Value, 1) = “張” Then
【全解vba初學者編程代碼大全 vba編程代碼大全】 arr(j) = Cells(i, 1).Value ‘給數組中各個元素賦值
j = j + 1 ‘索引號加1
End If
Next i
[b1:b65536].Clear ‘清除原有數據
[b1].Resize(1, xcount) = arr ‘對B1往右的xcount個單元格輸入數組的值
[b1].Resize(xcount, 1) =
Application.WorksheetFunction.Transpose(arr) ‘對B1往下的xcount個單元格輸入數組的值
End Sub
5判斷非空單元格，并提取（空格為一個）

文章插圖
Sub test()
Dim arr, arr1(1 To 10000, 1 To 1)
Dim x, m, k
arr = Range(“a1:a21”)
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(“b1”).Offset(0, m).Resize(k) = arr1
Erase arr1
k = 0
End If
Next x
End Sub
6數組計算

文章插圖
Sub test()
Dim arr, x
arr = Range(“a1:d6”)
For x = 1 To UBound(arr)
arr(x, 1) = arr(x, 1) * 3
arr(x, 2) = arr(x, 1) * 3
arr(x, 3) = arr(x, 1) * arr(x, 2)
arr(x, 4) = arr(x, 3) * arr(x, 2)
Next x
Range(“a8:d13”) = arr
End Sub
7字典

文章插圖
Sub t() ’（字典裝入數字）
Dim d
Dim arr
Dim x As Long
Set d = CreateObject(“scripting.dictionary”)
For x = 1 To 6
d.Add Cells(x, 1).Value, Cells(x, 2).Value’這種裝入只能在KEYS列裝入非重復的
Next x
Range(“d1”).Resize(d.Count) = Application.Transpose(d.keys)
Range(“e1”).Resize(d.Count) = Application.Transpose(d.items)
End Sub

文章插圖
Sub rr()
Dim d
Dim arr
Dim x As Long
arr = Range(“a1:b16”)
Set d = CreateObject(“scripting.dictionary”)
For x = 1 To 16
d(arr(x, 1)) = d(arr(x, 1)) + arr(x, 2)’這種修改的方法最常用，可以刪除重復值，單條件匯總
Next x
Range(“d1”).Resize(d.Count) = Application.Transpose(d.keys)
Range(“e1”).Resize(d.Count) = Application.Transpose(d.items)
End Sub
8提取所有工作表名稱
Sub 提取所有工作表名稱()
For x = 1 To Sheets.Count
Cells(x, 7) = Sheets(x).Name
Next x
End Sub
9刪除指定名字的sheet
Sub te()
Dim Arr1
On Error Resume Next
Application.DisplayAlerts = False
Arr1 = Range(Cells(1, 3), Cells(Cells(65536, 3).End(xlUp).Row, 3))’指定arr1內的名字將其刪除
For Each i In Arr1
Sheets(i).Delete
Next
Application.DisplayAlerts = True
End Sub
11創建指定名字的sheet
Sub 創建工作表()
Dim i As Integer
i = 2
Do While Sheets(1).Cells(i, 1) <> “”
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = Sheets(1).Cells(i, 1)
i = i + 1
Loop
End Sub

文章插圖
10 EXCEL文件中每個工作表的A1單元格填a
Sub tt()
For i = 1 To ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets(i).Cells(1, 1).Value = http://www.siweifengbao.com/“a”
Next
End Sub
12如何通過Excel VBA判斷單元格內是否包含某字符
關于這個問題本文分享兩段VBA代碼，都可實現該功能，以判斷單元格中是否包含”?”為例，具體代碼如下。

If cells(1,1) Like “*?*” Then
2. If InStr(1, cells(1,1), “?”) = 0 Then
用VBA判斷EXCEL元素是否包含特定字符的情況較為常用，且多放在循環語句中，從運行效率來講，第二種方法優于第一種，當然，如果把所有cells里的信息，在第一時間都抓到內存中，運行速度會更快。

13循環填單元格
Sub test()
Dim x As Long
Dim y As Integer
Dim tt As Single
tt = Timer
For x = 4 To 2000 Step 3
For y = 1 To Int(x / 3)
Cells(x, 1).Resize(3, 1) = Cells(1, 1) + y
Next y
Next x
MsgBox “ok,用時” & Timer – tt & “秒!”
End Sub

文章插圖
14隔一行插入一行空白行
Sub Macro1()
Dim n As Long
n = Range(“a65536”).End(xlUp).Row
For i = n – 1 To 1 Step -1
Cells(i + 1, 1).EntireRow.Insert Shift:=xlDown
Next
End Sub
15隔2行插入2行
Sub Macro2()
Dim n As Long
n = Range(“a65536”).End(xlUp).Row
For i = n + 1 To 2 Step -2
Rows(i & “:” & i + 2).Insert
Next
End Sub
16刪除空白行
Sub aa()
maxh = Sheet1.Range(“a65536”).End(3).Row
Range(“a1:a” & maxh).SpecialCells(xlCellTypeBlanks).select
selection.entirerow.delete
End Sub
17VBA批量刪除excel指定行（Excel奇數行）
Sub test()
Dim begin As Integer
Dim endValue As Integer
Dim jg As Integer
begin = 3 ‘開始行
endValue = http://www.siweifengbao.com/493 ‘結束行
jg = 1 ‘間隔 ‘千萬不要以為是2，因為當第3行被刪除后，第5行已經變成了第4行
Dim i As Integer
For i = begin To endValue Step jg
Range(“A” & i).EntireRow.Delete
Next i
End Sub

注：Range(“A1”).EntireColumn.Delete 這樣是刪除A1整列
Range(“A1”).EntireRow.Delete 這樣是刪除A1整行
Range(“A1”).Delete 這是刪除A1單元格 A2單元格會移上去
上述命令就好像你選中A1單元格后，右擊選擇 -》刪除，在彈出對話框中有四個選項

18Excel多個sheet中刪除固定區域的行數據
Public Sub delete()
Dim i As Integer, j As Integer
j = Worksheets.Count
For i = 1 To j
Sheets(i).Rows(“2:5”).delete Shift:=xlUp
Next
End Sub
19Excel多個sheet中刪除符合條件的行數據
Sub delete()
Dim y As Long
y = Sheets.Count
For s = 2 To y
For x = 1 To Sheets(1).[a65536].End(3).Row
For i = 1 To Sheets(s).[j65536].End(3).Row
If Sheets(s).Cells(i, 10) = Sheets(1).Cells(x, 1)Then ‘Sheets(i).屬性(方法) 中的i指的不是你為工作表標簽設置的名稱.指的是工作表在當前工作薄中的序號.
Sheets(s).Rows(i).delete
End If
Next i
Next x
Next s
End Sub
（根據sheets1A列單元格的值在其他sheets里面找到對應單元格的值的行刪除）
20數組舉例

文章插圖
Sub r()
Dim arr, arr1()
Dim x As Integer
arr = Range(“a1:a10”)
m = Application.CountIf(Range(“a1:a10”), “>10”)
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
Cells(1, 2).Resize(m, 1) = Application.WorksheetFunction.Transpose(arr1)
End Sub

文章插圖
Sub hebing()
a = “”
For i = 1 To Range(“A65536”).End(xlUp).Row + 1
If Cells(i, 1) = “” Then
Range(“C” & i + 1 & “:C” & Range(“A” & i + 1).End(xlDown).Row).Merge
Cells(Range(“A” & i – 1).End(xlUp).Row, 3) = a
a = “”
Else
If a = “” Then
a = Cells(i, 1)
Else
a = a & Cells(i, 1)
End If
End If
Next
End Sub