今天我们为大家总结几个常用的VBA代码,大家复制后,简单修改即可使用! 想了想,还是先写吧……
1、ALT+F11或者点击 【开发工具】- 【Visual Basic】,进入VBE编辑器,右击 - 新建模块!
3、点击 【开发工具】 - 【宏】- 【选项】,设置快捷键(案例中Ctrl+Q)以上就是如何使用代码的详细说明,下面我们就专注代码和功能演示!Sub AddStr()
Dim rng As Range
Dim add_str As String
add_str = Application.InputBox("请输入要添加的前缀内容:")
For Each rng In Selection
rng.Value = add_str & rng.Value
Next
End Subrng.Value = add_str & rng.Value
上面这句就是添加前缀的代码,如果你需要添加后缀,只需要做如下修改即可
rng.Value = rng.Value & add_str
1、在 【汇总】表的 B2单元格中输入要汇总的单元格地址2、点击【获取数据】,把整个工作薄中除了汇总表之外的全部表中对应区域依次粘贴到汇总表中,首列为表名'作者 :E精精
'功能 :根据提供的单元格地址,提取内容
'公众号:Excel办公实战
'日期 :20210430
'--------------------------------------------
Sub getDataByAddr()
Dim i As Long, n As Long
Dim iStart As Integer: iStart = 3
Dim maxRow As Long
'根据需要修改【汇总】这个汇总表名称
Const totalShtName As String = "汇总"
Dim totalSht As Worksheet
Set totalSht = ThisWorkbook.Worksheets(totalShtName)
'清空历史数据
totalSht.Range("A3").CurrentRegion.Offset(1, 0).ClearContents
Dim Sh As Worksheet
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name <> totalShtName Then
With totalSht
maxRow = .Cells(Rows.Count, 1).End(3).Row + 1
'复制粘贴内容
Sh.Range(.[B1]).Copy
.Cells(maxRow, 2).PasteSpecial xlPasteValues
'写入表名
.Cells(maxRow, 1).Resize(Range(.[B1]).Rows.Count, 1) = Sh.Name
End With
End If
Next
End Sub1、代码分为激活工作表,自动删除历史目录数据,重新按照目前的表名构建
2、第二部分为单元格双击事件,当我们双击单元格时触发,直接激活双击单元格中值所对应的表,如果为空或者不匹配不做任何动作,关闭了双击进入单元格的功能!'激活工作表,重新生成目录
Private Sub Worksheet_Activate()
Dim Sh As Worksheet
Dim n As Long: n = 1
'清空内容
Cells.ClearContents
[A1:b1] = [{"序号","目录"}]
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name <> "目录" Then
n = n + 1
Cells(n, 1) = n - 1
Cells(n, 2) = Sh.Name
End If
Next
With Range("A1").CurrentRegion
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End Sub
'双击单元格事件
Private Sub Worksheet_BeforeDoubleClick(ByVal _
Target As Range, Cancel As Boolean)
If Target.CountLarge > 1 Then End
On Error Resume Next
Cancel = True
If Target <> "" Then
Sheets(Target.Value).Select
End If
End Sub今天小编就简单写几个,一般也比较常用的,如果你懂点VBA可以根据实际需求稍微调整,进一步匹配自己的需求,轻松办公!
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请
点击举报。