本文目录一览：
excel 12.0 对应et 哪个版本
低版本的控制高版本一般都没什么问题，但是高版本的控制低版本就容易出现错误。
比如你编程时候引用的excel 9.0库，那么对应的97,2000,2003,2007等版本excel环境下，程序应该没问题，但是如果你引用的excel12.0库，如果安装到excel97的机器上，有可能出现错误。因为高版本的库可能有一些新对象，但低版本的应用并不支持这些对象。
所以，建议你编程时候引用word2003类库
EXCEL数据合并代码
Sub Macro1()
Dim MyPath$, MyName$, sh As Worksheet, sht As Worksheet
Application.ScreenUpdating = False
Set sh = ActiveSheet
MyPath = ThisWorkbook.Path "/"
MyName = Dir(MyPath "*.xls")
[a1].CurrentRegion.Offset(2).Clear
Do While MyName ""
If MyName ThisWorkbook.Name Then
With GetObject(MyPath MyName)
For Each sht In .Sheets
If sht.Name "总表" Then
If sht.[a65536].End(3).Row 3 Then
lr = sh.[a65536].End(3).Row + 1
r = sht.[a65536].End(3).Row - 3
sh.Cells(lr, 1).Resize(r) = Split(MyName, ".")(0)
sh.Cells(lr, 2).Resize(r) = sht.Name
'sht.[a1].CurrentRegion.Offset(3, 7).Copy sh.Cells(lr, 3)
sht.Range("A4:G" (r + 3)).Copy sh.Cells(lr, 3)
End If
End If
Next
.Close False
End With
End If
MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "ok"
End Sub
Sub 工作薄间工作表合并()
Dim FileOpen
Dim X As Integer
Application.ScreenUpdating = False
FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(.xlsx),.xlsx", MultiSelect:=True, Title:="合并工作薄")
X = 1
While X = UBound(FileOpen)
Workbooks.Open Filename:=FileOpen(X)
Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
X = X + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
errhadler:
MsgBox Err.Description
End Sub
Sub 指定表名提取成一工作薄() '字段必须要在第一列
On Error Resume Next
Dim Filename$, fn$, dq$, crr()
Set cnn = CreateObject("ADODB.Connection")
Dim arr, n, i, j, s$
Dim MyPath$, myFile$
Dim rs As Object
Set d = CreateObject("scripting.dictionary")
cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0';data source=" ThisWorkbook.FullName
[a1:p65536].ClearContents
MyPath = ThisWorkbook.Path "/"
myFile = Dir(MyPath "*.xls*")
n = CreateObject("Scripting.FileSystemObject").GetFolder(MyPath).Files.Count - 1 '计算文件个数，减1不包括自身
ReDim arr(1 To 1000, 1 To n) '定义arr,最大工作表数1000
Do While myFile ""
If myFile ThisWorkbook.Name Then '不等于本工作簿执行
j = j + 1
i = 1
arr(1, j) = Left(myFile, InStrRev(myFile, ".") - 1) '去后辍
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" MyPath myFile
Set rs = cnn.OpenSchema(20) 'Set rs = cnn.OpenSchema(adSchemaTables)，创建数据表记录集
Do Until rs.EOF
If rs.Fields("TABLE_TYPE") = "TABLE" Then
i = i + 1
s = Replace(rs("TABLE_NAME").Value, "'", "") '去除"’"(数字工作表）
If Right(s, 1) = "$" Then arr(i, j) = Left(s, Len(s) - 1) '去除$号
End If
rs.MoveNext
Loop
End If
myFile = Dir
Loop
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing
Range("A1").Resize(i, j) = arr '输出
Rows("1:1").Delete
bmc = ActiveSheet.Name
brr = Worksheets(bmc).UsedRange
For Each cf In brr
If cf "" Then
d(cf) = ""
End If
Next
Worksheets(bmc).UsedRange.Delete
Application.ScreenUpdating = True
[b3].Resize(d.Count, 1) = Application.Transpose(d.keys)
[b2] = "所有的工作表名如下 请选择！"
Set cnn = CreateObject("ADODB.Connection")
cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0';data source=" ThisWorkbook.FullName
Flag: Set zzdm = Application.InputBox(prompt:="请在出现的表名称中选择 可以点选 或者全选：", Type:=8)
Application.ScreenUpdating = False
For Each Rng In zzdm '计算出所选单元格的个数
If Rng "" Then
a = a + 1
ReDim Preserve crr(1 To a)
crr(a) = Rng
End If
Next
ll = UBound(crr)
Columns(2).Delete
For Each c In crr
If c = "" Then GoTo 333
zdm = c
Filename = Dir(ThisWorkbook.Path "/*.xls*")
Do While Filename ""
If Filename ThisWorkbook.Name Then
fn = ThisWorkbook.Path "/" Filename
Sql = "select * from [" fn "]." "[" zdm "$" "]"
r = [a65535].End(3).Row + 1
Cells(r, 1).CopyFromRecordset cnn.Execute(Sql)
r2 = [a65535].End(3).Row
yy = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1
If r2 1 Then
If jj = 0 Then
Set rs = cnn.Execute(Sql)
For i = 0 To yy - 1 '逐个字段
Cells(1, i + 1) = rs.Fields(i).Name '取字段名
jj = jj + 1
Next i
End If
End If
End If
Filename = Dir
Loop
ActiveSheet.Name = zdm
ll1 = ll1 + 1
If ll1 ll Then
ThisWorkbook.Sheets.Add After:=Worksheets(zdm)
End If
jj = 0
Next c
333:
cnn.Close: Set cnn = Nothing
Application.ScreenUpdating = True
MsgBox "提取完毕！"
End Sub
Sub mergeonexls() '合并多工作簿中指定工作表
On Error Resume Next
Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet
Dim t As Workbook, ts As Worksheet, l As Integer, h As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
x = Application.GetOpenFilename(FileFilter:="Excel文件 (*.xls; *.xlsx),*.xls; *.xlsx,所有文件(*.*),*.*", _
Title:="Excel选择", MultiSelect:=True)
Set t = ThisWorkbook
Set ts = t.Sheets(1) '指定合并到的工作表，这里是第一张工作表
l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column
For Each x1 In x
If x1 False Then
Set w = Workbooks.Open(x1)
Set wsh = w.Sheets(1) '指定所需合并工作表，这里是第一张工作表
h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then
wsh.UsedRange.Copy ts.Cells(1, 1)
Else
wsh.UsedRange.Copy ts.Cells(h + 1, 1)
End If
w.Close
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub 合并当前工作簿下的所有工作表()
Application.ScreenUpdating = False
For j = 1 To Sheets.Count
If Sheets(j).Name ActiveSheet.Name Then
X = Range("A65536").End(xlUp).Row + 1
Sheets(j).UsedRange.Copy Cells(X, 1)
End If
Next
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示"
End Sub
excel小数点后保留两位有效数字
excel小数点后保留两位有效数字可以借助函数，方法如下：
工具／原料：Lenovo12.0、windows12.0.0、excel12.0
1、新建excel，在A列中随意输入五行含有五位数字的小数。
2、在B1单元格中输入＝ROUND(A2,2)，也可以从菜单栏，公式插入函数中选择ROUND函数。
3、在弹出的函数参数设置对话框中，数值一栏选择A1，小数位数填写2，发现下面已经出现四舍五入的该数字。
4、点击键盘上的回车，发现数字已经四舍五入，之后将光标移至B1右下角，变成加粗十字光标，下拉会发现所有的数字全部保留两位小数。