全解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