excel,access常用公式函数VBA代码汇总文章
批量将CSV导入access
alt+f11 打开access的vbe环境
Sub test() Dim SQL As String Dim MyPath As String Dim MyPathDb As String Dim MyFile As String MyPath = "D:\temp\*.CSV" MyPathDb = "D:\temp" MyFile = Dir(MyPath) Do SQL = "insert into 110 select * from [Text;DATABASE=" & MyPathDb & "].[" & MyFile & "]" DoCmd.RunSQL SQL 'Debug.Print MyFile MyFile = Dir Loop Until MyFile = "" DoCmd.SetWarnings True End Sub
直接运行此函数即可
1.根据日期返回星期:=TEXT(A2,"aaaa") A2中为日期
2.提取文本超链接放到后一列,以下代码的作用就是把文本下的链接提取,并放在后面1列。
Sub 提取链接() Dim HL AsHyperlink For Each HL InActiveSheet.Hyperlinks HL.Range.Offset(0, 1).Value = HL.Address‘就是说把链接放在非单独链接的后面一列。 Next End Sub
3.检测单元格变动(变动后着色)
Private Sub Worksheet_Change(ByVal Target As Range) MsgBox ("changed") Target.Interior.ColorIndex = 3 Target.Font.ColorIndexf = 4 End Sub
4.操作其它excel的sheet
Private Sub CommandButton1_Click() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String flag = 0 Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path 'MsgBox MyPath MyName = Dir(MyPath & "\" & "*.xls") ' MsgBox MyName AWbName = ActiveWorkbook.Name Num = 0 Do While MyName <> "" If MyName <> AWbName Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) Num = Num + 1 'MsgBox "正在处理第" & Num & "个工作表,名字是:" & Wb.Name 'If Wb.Sheets(3).Name = "签约" Then With Workbooks(1).Worksheets(1) ' MsgBox Workbooks(1).Worksheets(1).Name 'wb.sheets(“xxx”).usedrange.copy 报错 Wb.Sheets("签约").Range("a1:L65535").Copy .Cells(.Range("A65536").End(xlUp).Row + 1, 1) .UsedRange.Rows.AutoFit .UsedRange.Columns.AutoFit End With ' End If flag = 1 WbN = WbN & Chr(13) & Wb.Name Wb.Close SaveChanges:=0 ' End With End If MyName = Dir Loop Range("A1").Select Application.ScreenUpdating = True MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN, vbInformation, "提示" End Sub