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