以下我写的VBA代码执行到红色的那句就出现错误提示,无法运行,请求您的帮助
2011-04-26 08:47
417 查看
Sub 过上年帐册()
Dim LuJin As Variant
If Workbooks("GZ.xls").Sheets("CK").Cells(2, 19) = "☆" Then
MsgBox "您已经记过帐,,请勿重复!!"
Else
Application.Run "GZ.xls!源路径"
LuJin = Workbooks("GZ.xls").Sheets("CK").Cells(2, 20)
If LuJin = "" Then
MsgBox "源帐册路径/文件名未填写,程序将退出运行!"
Else
Application.ScreenUpdating = False '关闭屏幕更新
L = 1: 过材料库帐册: 过成品库帐册: 过样品库帐册 '
'删除空行
Workbooks("GZ.xls").Sheets("CK").Cells(2, 19) = "☆"
ActiveSheet.Protect红色
ActiveWorkbook.Save
End If
End If
Application.ScreenUpdating = True '屏幕更新
End Sub
Sub 过材料库帐册()
Dim Y As Long
Dim LuJin, Sql, Sq2, Conn As Variant
LuJin = Workbooks("GZ.xls").Sheets("CK").Cells(2, 20)
Y = [B65536].End(xlUp).Row + 1
ActiveSheet.Unprotect '撤消当前工作表保护
Range("A5:L" & Y).ClearContents
Set Conn = CreateObject("adodb.connection") '(1)设置对象
For n = 1 To 40
w = [D65536].End(xlUp).Row + 2
Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & LuJin & "/" & "A" & n & ".xls" 'ThisWorkbook.Path指当前路径下的工作簿
Sql = "select * from [A" & n & "$B5:F260" & "]"
Sq2 = "select * from [A" & n & "$CM5:CO260" & "]"
Range("D" & w & ":" & " H65536").CopyFromRecordset Conn.Execute(Sql) '将数据源A1到A40的的B/C列复制到D和E列
Range("I" & w & ":" & " K65536").CopyFromRecordset Conn.Execute(Sq2)
m = [D65536].End(xlUp).Row + 1
Range("B" & w & ":B" & m) = "A" & n
Conn.Close '关闭链接
Next n
Set Conn = Nothing '释放对象变量
End Sub
Sub 删除空行()
Dim m As String
Sheets("CK").Select
q = 5
Do While Not (IsEmpty(Sheets(ActiveSheet.Name).Cells(q, 6).Value))
q = q + 1
Loop
t = q - 1
For x = 5 To t
m = Round(Cells(x, 6), 2)
If m = 0 Then
Range(Cells(x, 1), Cells(x, 12)).Select
Selection.Delete Shift:=xlUp
x = x - 1
t = t - 1
Else
End If
If x = t Then
Exit For
End If
Next x
ActiveWorkbook.Save
End Sub
Sub 过成品库帐册()
Dim Y As Long
Dim LuJin, Sql, Sq2, Conn As Variant
LuJin = Workbooks("GZ.xls").Sheets("CK").Cells(2, 20)
Y = [B65536].End(xlUp).Row + 1
ActiveSheet.Unprotect '撤消当前工作表保护
Range("A5:L" & Y).ClearContents
Set Conn = CreateObject("adodb.connection") '(1)设置对象
For n = 1 To 40
w = [D65536].End(xlUp).Row + 2
Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & LuJin & "/" & "B" & n & ".xls" 'ThisWorkbook.Path指当前路径下的工作簿
Sql = "select * from [B" & n & "$B5:F260" & "]"
Sq2 = "select * from [B" & n & "$CM5:CO260" & "]"
Range("D" & w & ":" & " H65536").CopyFromRecordset Conn.Execute(Sql)
Range("I" & w & ":" & " K65536").CopyFromRecordset Conn.Execute(Sq2)
m = [D65536].End(xlUp).Row + 1
Range("B" & w & ":B" & m) = "B" & n
Conn.Close '关闭链接
Next n
Set Conn = Nothing '释放对象变量
End Sub
Sub 过样品库帐册()
Dim Y As Long
Dim LuJin, Sql, Sq2, Conn As Variant
LuJin = Workbooks("GZ.xls").Sheets("CK").Cells(2, 20)
Y = [B65536].End(xlUp).Row + 1
Range("A5:L" & Y).ClearContents
Set Conn = CreateObject("adodb.connection") '(1)设置对象
For n = 1 To 20
w = [D65536].End(xlUp).Row + 2
Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & LuJin & "/" & "C" & n & ".xls" 'ThisWorkbook.Path指当前路径下的工作簿
Sql = "select * from [C" & n & "$B5:F260" & "]"
Sq2 = "select * from [C" & n & "$CM5:CO260" & "]"
Range("D" & w & ":" & " H65536").CopyFromRecordset Conn.Execute(Sql)
Range("I" & w & ":" & " K65536").CopyFromRecordset Conn.Execute(Sq2)
m = [D65536].End(xlUp).Row + 1
Range("B" & w & ":B" & m) = "C" & n
Conn.Close '关闭链接
Next n
Set Conn = Nothing '释放对象变量
End Sub
Dim LuJin As Variant
If Workbooks("GZ.xls").Sheets("CK").Cells(2, 19) = "☆" Then
MsgBox "您已经记过帐,,请勿重复!!"
Else
Application.Run "GZ.xls!源路径"
LuJin = Workbooks("GZ.xls").Sheets("CK").Cells(2, 20)
If LuJin = "" Then
MsgBox "源帐册路径/文件名未填写,程序将退出运行!"
Else
Application.ScreenUpdating = False '关闭屏幕更新
L = 1: 过材料库帐册: 过成品库帐册: 过样品库帐册 '
'删除空行
Workbooks("GZ.xls").Sheets("CK").Cells(2, 19) = "☆"
ActiveSheet.Protect红色
ActiveWorkbook.Save
End If
End If
Application.ScreenUpdating = True '屏幕更新
End Sub
Sub 过材料库帐册()
Dim Y As Long
Dim LuJin, Sql, Sq2, Conn As Variant
LuJin = Workbooks("GZ.xls").Sheets("CK").Cells(2, 20)
Y = [B65536].End(xlUp).Row + 1
ActiveSheet.Unprotect '撤消当前工作表保护
Range("A5:L" & Y).ClearContents
Set Conn = CreateObject("adodb.connection") '(1)设置对象
For n = 1 To 40
w = [D65536].End(xlUp).Row + 2
Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & LuJin & "/" & "A" & n & ".xls" 'ThisWorkbook.Path指当前路径下的工作簿
Sql = "select * from [A" & n & "$B5:F260" & "]"
Sq2 = "select * from [A" & n & "$CM5:CO260" & "]"
Range("D" & w & ":" & " H65536").CopyFromRecordset Conn.Execute(Sql) '将数据源A1到A40的的B/C列复制到D和E列
Range("I" & w & ":" & " K65536").CopyFromRecordset Conn.Execute(Sq2)
m = [D65536].End(xlUp).Row + 1
Range("B" & w & ":B" & m) = "A" & n
Conn.Close '关闭链接
Next n
Set Conn = Nothing '释放对象变量
End Sub
Sub 删除空行()
Dim m As String
Sheets("CK").Select
q = 5
Do While Not (IsEmpty(Sheets(ActiveSheet.Name).Cells(q, 6).Value))
q = q + 1
Loop
t = q - 1
For x = 5 To t
m = Round(Cells(x, 6), 2)
If m = 0 Then
Range(Cells(x, 1), Cells(x, 12)).Select
Selection.Delete Shift:=xlUp
x = x - 1
t = t - 1
Else
End If
If x = t Then
Exit For
End If
Next x
ActiveWorkbook.Save
End Sub
Sub 过成品库帐册()
Dim Y As Long
Dim LuJin, Sql, Sq2, Conn As Variant
LuJin = Workbooks("GZ.xls").Sheets("CK").Cells(2, 20)
Y = [B65536].End(xlUp).Row + 1
ActiveSheet.Unprotect '撤消当前工作表保护
Range("A5:L" & Y).ClearContents
Set Conn = CreateObject("adodb.connection") '(1)设置对象
For n = 1 To 40
w = [D65536].End(xlUp).Row + 2
Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & LuJin & "/" & "B" & n & ".xls" 'ThisWorkbook.Path指当前路径下的工作簿
Sql = "select * from [B" & n & "$B5:F260" & "]"
Sq2 = "select * from [B" & n & "$CM5:CO260" & "]"
Range("D" & w & ":" & " H65536").CopyFromRecordset Conn.Execute(Sql)
Range("I" & w & ":" & " K65536").CopyFromRecordset Conn.Execute(Sq2)
m = [D65536].End(xlUp).Row + 1
Range("B" & w & ":B" & m) = "B" & n
Conn.Close '关闭链接
Next n
Set Conn = Nothing '释放对象变量
End Sub
Sub 过样品库帐册()
Dim Y As Long
Dim LuJin, Sql, Sq2, Conn As Variant
LuJin = Workbooks("GZ.xls").Sheets("CK").Cells(2, 20)
Y = [B65536].End(xlUp).Row + 1
Range("A5:L" & Y).ClearContents
Set Conn = CreateObject("adodb.connection") '(1)设置对象
For n = 1 To 20
w = [D65536].End(xlUp).Row + 2
Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & LuJin & "/" & "C" & n & ".xls" 'ThisWorkbook.Path指当前路径下的工作簿
Sql = "select * from [C" & n & "$B5:F260" & "]"
Sq2 = "select * from [C" & n & "$CM5:CO260" & "]"
Range("D" & w & ":" & " H65536").CopyFromRecordset Conn.Execute(Sql)
Range("I" & w & ":" & " K65536").CopyFromRecordset Conn.Execute(Sq2)
m = [D65536].End(xlUp).Row + 1
Range("B" & w & ":B" & m) = "C" & n
Conn.Close '关闭链接
Next n
Set Conn = Nothing '释放对象变量
End Sub
相关文章推荐
- 以下我写的VBA代码执行到红色的那句就出现错误提示,无法运行,请求您的帮助
- 安装SQL Server 2000时出现以下错误提示:“以前的某个程序安装已在安装计算机创建挂起的文件操作,运行安装程序之前必须重新启动计算机” 说明:如果重启计算机无法解决问题,可能有以下两个原因
- 海思平台程序运行出现无法在虚拟地址处理内核分页请求错误
- 在windows直接运行Qt编译出来的可执行程序出现了如下提示错误: this application has requested the runtime to terminate it an unu
- Exchange2010 OWA登录后,点击任何按钮提示“出现意外错误,无法处理您的请求”
- 今天更新代码之后,突然出现一个问题:Tomcat启动时,总是会出现jvm fatal error错误导致tomcat无法正常启动,以下是错误信息:
- SqlServer2008 R2 安装失败提示出现以下错误 服务 MSSQLSERVEROLAPSERVICE 启动请求失败
- IIS 标致显示红色ERROR,停止运行。无法启动,提示发生意外错误0x8ffe2740
- Android studio 出现java.lang.NoClassDefFoundError错误的一种解决方案 5.0以下机型无法运行应用报错
- 启动SQL Server 2005 配置管理器时,出现以下提示错误,无法连接到WMI提供程序。您没有权限或者该服务器无法访问
- Android studio 出现java.lang.NoClassDefFoundError错误的一种解决方案 5.0以下机型无法运行应用报错
- android导入工程出现红色感叹号运行提示错误
- 建立工程后刚开始编译出现了“error PRJ0003 : 生成 cmd.exe 时出错”这样的错误,虽然在debug中生成了.exe文件,但是无法执行,提示找不到mfc90ud.dll。
- 网狐荣耀版vs生成解决方案时出现“出现未能写入日志,请求的操作无法在使用用户映射区域打开的文件上执行“错误
- android导入工程出现红色感叹号运行提示错误
- Server SQL 发布复制事物时的错误提示:读取代理器未运行 进程无法在“WIN-XXX”上执行“sp_replcmds”
- vs2010出现红色波浪错误提示但运行通过
- [备忘]IIS 7.5运行.aspx出现“由于 Web 服务器上的“ISAPI 和 CGI 限制”列表设置,无法提供您请求的页面。”错误解决方法
- ArcGis :出现以下错误: 80040111 ClassFactory 无法供应请求的类别