隐藏指定工作表的指定列
Sub 隐藏指定工作表的指定列()
Sheet1.Columns("B:B").EntireColumn.Hidden = True
End Sub
把a列不重复值取到e列
Sub 把a列不重复值取到e列()
[A:A].AdvancedFilter 2, , [e1], 1
End Sub
当前选区的行列数
Sub 当前选区的行列数()
Range("A1") = Selection.Rows.Count '当前选区的行数
Range("B1") = Selection.Columns.Count '当前选区的列数
End Sub
单元格录入1位字符就跳转(工作表代码)
Private Sub TextBox1_Change()
If Len(Me.TextBox1.Text) <> 1 Then Exit Sub
Me.TextBox1.Activate
ActiveCell = Me.TextBox1.Text
Me.TextBox1.Text = ""
ActiveCell.Activate
Application.SendKeys "~"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With TextBox1
.Left = ActiveCell.Left
.Top = ActiveCell.Top
.Width = ActiveCell.Width
.Height = ActiveCell.Height
End With
Me.TextBox1.Activate
End SubSub
当指定日期（每月10日）打开文件执行宏
Sub auto_open()
If Day(Date) = 10 Then
重排窗口
End If
End Sub
提示并清空单元区域
Sub 清空单元区域()
If MsgBox("是否真的要清空数据?清除后将无法恢复", 1 + vbokNo) = vbOK Then
Range("A1:B10,A15:B25").ClearContents
End If
End Sub
返回光标所在行号
Sub 返回光标所在行号()
Range("A1") = Selection.Row
End Sub
VBA返回公式结果
Sub VBA返回公式结果()
x = Application.WorksheetFunction.Sum(Range("a2:a100"))
Range("B1") = x
End Sub
按照当前行A列的图片名称插入图片到H列
Sub 按照当前行A列的图片名称插入图片到H列()
AAA = Selection.Row
Range("H" & AAA).Select
Selection.RowHeight = 37 '指定行高
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Range("A" & Selection.Row) & ".JPG").Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 84.75
Selection.ShapeRange.Width = 150.75
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.ScaleWidth 0.73, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.73, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.24, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft
Range("H" & AAA).Select
End Sub
当前行下插入1行
Sub 当前行下插入1行()
Selection.Offset(1, 0).Insert
End Sub
取消指定行或列的隐藏
Sub 取消隐藏行()
Rows("3:5").Select
Selection.EntireRow.Hidden = False
End Sub
Sub 取消隐藏列()
Columns("C:F").Select
Selection.EntireColumn.Hidden = False
End Sub
复制单元格所在行
Sub 复制单元格所在行()
Selection.EntireRow.Copy
End Sub
复制单元格所在列
Sub 复制单元格所在列()
Selection.EntireColumn.Copy
End Sub
新建一个工作表
Sub 新建一个工作表()
Sheets.Add
End Sub
新建一个工作簿
Sub 新建一个工作簿()
Workbooks.Add
End Sub
选择多表为工作组
Sub 选择多表为工作组()
Dim Wks As Worksheet, shtCnt As Integer
Dim arr() As Variant, i As Integer, m As Integer, m1 As Integer, m2 As Integer
shtCnt = ThisWorkbook.Sheets.Count '取得工作表总数
ReDim arr(1 To shtCnt) '预定义数组
i = 0
m = 1 '循环的次数
m1 = 0 '找到起点循环的次数
m2 = 0 '找到终点循环的次数
For Each Wks In ThisWorkbook.Sheets '在所有工作表中循环
If Wks.Name = "A2" Then '工作组中第一个工作表名称
i = i + 1
arr(i) = Wks.Name '将工作表名称存进数组
m1 = m
End If
If Wks.Name Like "A7" Then '工作组中最后一个个工作表名称
i = i + 1
arr(i) = Wks.Name '将工作表名称存进数组
m2 = m
Exit For
End If
If i > 0 And m > m1 Then
i = i + 1
arr(i) = Wks.Name '将工作表名称存进数组
End If
m = m + 1
Next
If m2 > m1 Then '如果存在符合条件的工作表名称
ReDim Preserve arr(1 To i) '重定义数组
ThisWorkbook.Sheets(arr).Select '选中符合条件的所有工作表
End If
End Sub