求助Excel VBA高手,请帮我把代码翻译成中文,告诉我此代码是什么意思!请详细一点!谢谢!
Sub CombineFiles() //建立方法
Dim path As String //定义String(字符串)型变量path
Dim FileName As String //定义String型变量path
Dim LastCell As Range //定义Range (单元格)型变量path
Dim Wkb As Workbook //定义Workbook(excle) String型变量path
Dim WS As Worksheet //定义Worksheet (工作表)String型变量path
Dim ThisWB As String //定义String型变量path
Dim MyDir As String //定义String型变量MyDir
MyDir = ThisWorkbook.path & "\" //MyDir = 现在的文件路径+"\"
'ChDriveLeft(MyDir, 1) 'find all the excel files//被注释掉了
'ChDir MyDir//被注释掉了
'Match =Dir$("")//被注释掉了
ThisWB = ThisWorkbook.Name //ThisWB = 现在打开的文件的名字(我记得文件名是caption,这个应该也是文件名吧)
Application.EnableEvents = False //这个是禁用触发事件(防止重复触发)
Application.ScreenUpdating = False//禁用屏幕刷新
path = MyDir //简单的赋值语句
FileName = Dir(path & "\*.xls", vbNormal)//简单的赋值语句\(调用了Dir方法 ,为FileName 赋值)
Do Until FileName = "" //循环直到FileName 为空
If FileName ThisWB Then //如果FileName 不等于ThisWB 那么
Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName) //打开一个文件(文件路径 path & "\" & FileName) 并把这个文件记录到 wkb变量
For Each WS In Wkb.Worksheets //循环所有sheet页
Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell) //取得最后一个单元格
If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then //如果没有值并且地址在(第一位???这个不太确定)
Else
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) //复制sheet页
End If
Next WS
Wkb.Close False //关闭文件
End If
FileName = Dir() //调用dir()方法
Loop //循环
Application.EnableEvents = True//打开事件触发
Application.ScreenUpdating = True//打开页面刷新
Set Wkb = Nothing//清空
Set LastCell = Nothing//清空
End Sub
不用VBA
将DISCRIPTION列复制出来
打开浏览器,输入http://translate.google.cn/#en/zh-CN/
粘贴到左侧窗口中
等谷歌翻译结束,将右侧窗口中的文本复制
然后粘贴到EXCEL文件中的空白列,修改标题为“中文名”
收工、下班!^_^
Dim i As Long, u As Long, p As Long '定义变量 i 为 长整型值,u 为 长整型值,p 为 长整型值
Dim j As Integer, t, q, LL As Integer '定义变量 j 为 整型值,t,q,LL 为 整型值
Dim bh As String '定义变量 bh 为 字符串
Dim JUDGE As String '定义变量 JUDGE 为 字符串
Dim STP As Integer '定义变量 STP 为 整型值
'编号
If Range("m6") = "" Then '如果 <单元格>区域("m6")=空值 则执行
bh = Format(Now, "yyyymmdd") & "001" ' bh=Format(当前时间,"yyyymmdd") & "001"
Range("m6") = bh '<单元格>区域("m6")= bh
End If 'If判断过程结束
'编号
If Format(Now, "yyyymmdd") = Left(Cells(6, 12), 8) Then '如果 Format(当前时间,"yyyymmdd")=<截取字符串左侧>(<单元格>坐标(6,12),8) 则执行
bh = Format(Now, "yyyymmdd") & Right("000000" & CStr(CInt(Right(Cells(6, 12), 3)) + 1), 3) ' bh=Format(当前时间,"yyyymmdd") & 截取字符串右侧("000000" & CStr(CInt(截取字符串右侧(<单元格>坐标(6,12),3))+1),3)
Range("m6") = bh '<单元格>区域("m6")= bh
Else '另外
bh = Format(Now, "yyyymmdd") & "001" ' bh=Format(当前时间,"yyyymmdd") & "001"
Cells(6, 12) = bh '<单元格>坐标(6,12)= bh
End If 'If判断过程结束
If Range("S3").Value = 2 Then '如果 <单元格>区域("S3" )的值=2 则执行
If Cells(7, 5).Value = "" Then '如果 <单元格>坐标(7,5 )的值=空值 则执行
MsgBox "领用单位不能为空。", vbOKOnly, "友情提示!!!" '<消息框>:"领用单位不能为空。",vbOKOnly,"友情提示!!!"
Cells(7, 5).Select '<单元格>坐标(7,5 )的选定
Exit Sub '退出子程序
End If 'If判断过程结束
End If 'If判断过程结束
i = 9 'i=9
Do Until Len(Range("F" & i).Text) = 0 '执行循环操作 直到<字符串长度值>(<单元格>区域("F" & i )的文本)=0
If Cells(i, 4).Value = "" Then '如果 <单元格>坐标(i,4 )的值=空值 则执行
MsgBox "日期不能为空。", vbOKOnly, "友情提示!!!" '<消息框>:"日期不能为空。",vbOKOnly,"友情提示!!!"
Cells(i, 4).Select '<单元格>坐标(i,4 )的选定
Exit Sub '退出子程序
End If 'If判断过程结束
If Cells(i, 9).Value = "" Then '如果 <单元格>坐标(i,9 )的值=空值 则执行
MsgBox "数量不能为空。", vbOKOnly, "友情提示!!!" '<消息框>:"数量不能为空。",vbOKOnly,"友情提示!!!"
Cells(i, 9).Select '<单元格>坐标(i,9 )的选定
Exit Sub '退出子程序
End If 'If判断过程结束
i = i + 1 'i=i+1
Loop '循环执行
If Cells(9, 4).Value <> "" Then '如果 <单元格>坐标(9,4 )的值 不等于 空值 则执行
If Range("s3") = 1 Then '如果 <单元格>区域("s3")=1 则执行
JUDGE = "入库清单" 'JUDGE="入库清单"
STP = 16 'STP=16
Else '另外
JUDGE = "出库清单" 'JUDGE="出库清单"
STP = 31 'STP=31
End If 'If判断过程结束
Sheets(JUDGE).Select '<工作表>(JUDGE )的选定
ActiveSheet.Unprotect ' 活动工作表的取消保护
i = Val(Sheets(JUDGE).Range("b65536").End(xlUp).Row) 'i=<提取数字>(<工作表>(JUDGE )的<单元格>区域("b65536" )的<末端>(方向向上 )的行标)
u = Val(Sheets("单据录入").Range("T3").Value) 'u=<提取数字>(<工作表>("单据录入" )的<单元格>区域("T3" )的值)
p = Val(Sheets("单据录入").Range("U3").Value) 'p=<提取数字>(<工作表>("单据录入" )的<单元格>区域("U3" )的值)
For t = 1 To p '设定变量范围为t=1到p
For j = 1 To u + 1 '设定变量范围为j=1到u+1
Sheets(JUDGE).Cells(i + t, j).Value = Sheets("单据录入").Cells(8 + t, j + STP - 1).Value '<工作表>(JUDGE )的<单元格>坐标(i+t,j )的值=<工作表>("单据录入" )的<单元格>坐标(8+t,j+STP-1 )的值
Next j '下一个j
Next t '下一个t
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ' 活动工作表的保护保护图形=True,内容=True,方案=True
Sheets("单据录入").Select '<工作表>("单据录入" )的选定
'ActiveWorkbook.Save '保存
MsgBox "保存成功", vbOKOnly '<消息框>:"保存成功",vbOKOnly
ActiveSheet.Unprotect ' 活动工作表的取消保护
Range("E7,H7,K7,M6,D9:E15,E15,i9:i15,l9:l15,N9:N15").Select '<单元格>区域("E7,H7,K7,M6,D9:E15,E15,i9:i15,l9:l15,N9:N15" )的选定
Selection.ClearContents ' 被选项的清除内容
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True ' 活动工作表的保护保护图形=True,内容=True,方案=True
End If 'If判断过程结束
Range("E7").Select '<单元格>区域("E7" )的选定
End Sub '子程序结束
'强制声明
Option Explicit
'单元格更改时触发事件
Private Sub Worksheet_Change(ByVal Target As Range)
'如果活动单元格大于1时停止程序
If Target.Count > 1 Then Exit Sub
'使用Intersect方法判断所选单元格
If Intersect([b2].CurrentRegion, Target) Is Nothing Then Exit Sub
'声明变量
Dim yf$, r1, rq, c%, ad$
'将B2单元格的值赋值给变量yf
yf = [b2].Value
'将活动单元格的位置赋值给变量ad
ad = Target.Address
'将活动单元格所在的列号减7后赋值给变量c
c = Target.Column - 7
'将获取的单元格值赋值给变量rq
rq = Target.Offset(0, -c)
'使用Find方法在49行至504行单元格区域内查找
Set r1 = Rows("49:504").Find(rq, , , 1)
'如果找到
If Not r1 Is Nothing Then
'写入当前活动单元格的值
Cells(r1.Row, r1.Column).Offset(0, c) = Target.Value
End If
End Sub
'单元格激活时触发事件
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'如果活动单元格大于2时停止程序
If Target.Count > 2 Then Exit Sub
'使用Intersect方法判断所选单元格
If Intersect([a1:m1], Target) Is Nothing Then Exit Sub
'声明变量
Dim yf$, r1, rng As Range
'将活动单元格的位置赋值给变量yf
yf = Target.Value
'使用Find方法在49行至504行单元格区域内查找
Set r1 = Rows("49:504").Find(yf, , , 1)
'如果找到
If Not r1 Is Nothing Then
'赋值给变量rng
Set rng = Range(r1.Address).CurrentRegion
'将变量rng 的值复制到B2单元格
rng.Copy [b2]
End If
End Sub
贰芳涩肠: 当用户禁用宏,或者提高宏的安全级别,或者不信任源代码,则楼主的一切就将白费力气! 如果楼主真的想这么做的话,建议使用 Office 提供的 Windows Right Management 管理功能.当然,如果没有专门的服务器才提供这个服务的话,可以试用微软公司提供的试用服务.在这个服务功能中,你可以给指定的人员设置不允许打印,不允许复印,有效期等等功能.当非指定的人员试图去打开你的文件的时候,只能发邮件向你请求权限.
金秀瑶族自治县17540071820: 求救 EXCEL中我如何使用宏 请VBA高手帮忙 - ?
贰芳涩肠: 先把两个excel同时打开,把第二个excel整体复制粘贴到第一个excel第二个工作簿中,然后关闭第二个excel,选择工具—宏—visual basic编辑器 ,找到 插入—模块,在模块中输入:sub charu() for i = 3 to 4 for j=1 to 65000 sheet1.cells(j,i)=sheet2.cells(j-2,i) next j next i end sub
金秀瑶族自治县17540071820: 求助EXCEL VBA 的高手们!! - ?
贰芳涩肠: VBA有高手写好了,不用VBA的方法说一个:打开任意一个Excel文件,工具----选项----常规 页面,里面有一条“启动时打开此目录中的所有文件”,输入你要打开的这个文件夹的目录.保存并退出所有Excel.再重启Excel就能打开所有你想打开的Excel了.(处理完了之后,最好把选项中的此目录清掉,否则每次开启Excel都会打开全部的这些Excel文档.当然,如果楼主每次都要进行这样的操作,就一直保留即可.)
金秀瑶族自治县17540071820: excel表格VBA代码高手请进,帮我优化代码 - ?
贰芳涩肠: Private Sub Worksheet_Change(ByVal Target As Range)If Target.Row = 1 Or Target.Cells.Count > 1 Then Exit SubApplication.EnableEvents = FalseSelect Case Target.
金秀瑶族自治县17540071820: 请高手帮忙写个excel vba程序~?
贰芳涩肠: VBA可以实现,我也可以给你编一个.但是,我的原则是,如果Excel自带的公式和功能可以实现,绝不用VBA——它也有很大的局限性,甚至是危害性. 下面给出的方法,只是用VLOOKUP函数和条件格式就可以完成: 假设两个表格在一个工...
金秀瑶族自治县17540071820: Excel VBA代码求解!高手请指点! - ?
贰芳涩肠: 你的解释是对的d(arr(i, 1)) = d(arr(i, 1)) ," & i解释:这个是将d(arr(i, 1))的item 更新为: 原来的item 再接上 "," 和i,这个Key没变,就改变了ite...
金秀瑶族自治县17540071820: Excel VBA编程 请高手帮忙 - ?
贰芳涩肠: range("A1").offset(1)=range("B1") rowsource=ragne("A1").offset(1)不知所云
金秀瑶族自治县17540071820: 请教EXCEL,VBA宏相关问题,请高手指教! - ?
贰芳涩肠: 点击要放入图形的单元格标签,点右键选“查看代码”,把下面代码复制进去.第一次执行时,要先执行“添加形状”宏,只执行一次即可,就自动生成圆、矩形与直线,以后就不用再执行了.只要改变A1\A2\A3格中数值,就可使三个形状显...
金秀瑶族自治县17540071820: 求救大神帮我做一个EXCEL的VBA:用鼠标选中一块区域,在这块区域中,随机清除其中10个单元格的数据,谢谢 - ?
贰芳涩肠: 代码 如下: 需Excel 内启用宏 使用,Alt+F8运行 Sub randclear()Set dic = CreateObject("scripting.dictionary")num = Selection.Cells.CountIf num < 10 ThenMsgBox "选区单元格数小于10,请重新选择": Exit SubEnd IfDoRandomize ...
金秀瑶族自治县17540071820: VBA代码求助,菜鸟不太懂,求excel宏高手帮我在每一句后面标个释义,非常谢谢. - ?
贰芳涩肠: Sub fp1() Sheet6.Range("D38").Formula = "=D39" '在sheet6的D38单元格输入=D39的公式 End Sub Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next '设置错误处理 Application.ScreenUpdating = False '关闭...