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 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 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 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 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 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 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 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 Sub 提取所有工作表名称() For x = 1 To Sheets.Count Cells(x, 7) = Sheets(x).Name Next x End Sub 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 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 Sub tt() For i = 1 To ActiveWorkbook.Worksheets.Count ActiveWorkbook.Worksheets(i).Cells(1, 1).Value = "a" Next End Sub 关于这个问题本文分享两段VBA代码,都可实现该功能,以判断单元格中是否包含”?”为例,具体代码如下。 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 Sub Macro1() 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 Sub aa() maxh = Sheet1.Range("a65536").End(3).Row Range("a1:a" & maxh).SpecialCells(xlCellTypeBlanks).select selection.entirerow.delete End Sub Sub test() Dim begin As Integer Dim endValue As Integer Dim jg As Integer begin = 3 '开始行 endValue = 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 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 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里面找到对应单元格的值的行删除) 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 Sub1单元格合并:
2. 单元格区域存入VBA数组
3一维VBA数组放入单元格区域中
4提取符合条件的单元格
5判断非空单元格,并提取(空格为一个)
6数组计算
7字典
8提取所有工作表名称
9删除指定名字的sheet
11创建指定名字的sheet
10 EXCEL文件中每个工作表的A1单元格填a
12如何通过Excel VBA判断单元格内是否包含某字符
2. If InStr(1, cells(1,1), “?”) = 0 Then
用VBA判断EXCEL元素是否包含特定字符的情况较为常用,且多放在循环语句中,从运行效率来讲,第二种方法优于第一种,当然,如果把所有cells里的信息,在第一时间都抓到内存中,运行速度会更快。13循环填单元格
14隔一行插入一行空白行
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 Sub15隔2行插入2行
16删除空白行
17VBA批量删除excel指定行 (Excel奇数行)
18Excel多个sheet中删除固定区域的行数据
19Excel多个sheet中删除符合条件的行数据
20数组举例