Sub Dowhile3()
Dim LineCt As Long '定义长整型变量
Dim LineOfText As String '定义字符串变量
Open "\Documents and Settings\Administrator\桌面\bulletintxt" For Input As #1 ’打开文件
LineCt = 0 '变量赋值
Do While Not EOF(1) '循环语句与loop匹配,检测是否到文件尾。符合条件则退出
Line Input #1, LineOfText '按行读取数据,写入LineOfText
Range("A1")Offset(LineCt, 0) = UCase(LineOfText) '将数据写入sheet1表a1中,Offset(LineCt, 0)向下偏移LineCt=1则目标为A2 ,UCase转成大写字符
LineCt = LineCt + 1 '累加变量每读一行增加1
Loop '循环语句
Close #1 '关闭文件号1的文件
End Sub
系统默认情况下
注释的内容被显示成绿色
有语法错误的语句被显示成**底纹
但是,这个显示颜色可以自定义设置
设置步骤:工具,选项,编辑器格式
Dim RS As Integer ''''''定义 rs,cs,t,i,j,c
Dim CS As Integer
Dim T As Integer
Dim i As Integer
Dim j As Integer
Dim c As Integer
T = 0 '''''T赋初值0
c = 2 '''''C赋初值2
Range("F:F")SpecialCells(xlCellTypeBlanks)EntireRowDelete '''''''''''删除F列的空单元格,,其实我对这段代码不太熟悉。大致意思
'delete blank row from sheet
RS = ActiveWorkbookWorksheets(2)Range("A65536")End(xlUp)Row ''''''rs=表2的第A列的最后一个非空单元格
For i = 2 To RS ''''''定义循环变量,i=2 到 rs 一直执行for next 中间的代码直到i>rs
c = T + c
T = Range("F" & c) ''''''t=单元格F&C,其中C为变量,即F2 到F&RS
If T <> 1 Or 0 Then
For j = 2 To T ''''''定义循环变量,j=2 到t 一直执行for next 中间的代码直到i>t
Rows(c + j - 2)Select ''''选中,c+j-2行
SelectionCopy ''''选中部分复制
Rows(c + j - 1)Select ''''选中,c+j-1行
SelectionInsert Shift:=xlDown '''''在选中行插入一列,以下单元格下移
Range("g" & c + j - 1) = Range("g" & c + j - 2) + 1 '''''给单元格g&c+j-1赋值等于单元格g&c+j-2的值+1
Next j '''''''循环执行j
End If ''''''''退出条件
Next i '''''''循环执行i
'main program for tear down
CS = ActiveWorkbookWorksheets(2)Range("A65536")End(xlUp)Row '''cs等于活动工作薄,即当前工作薄的表2的A列最后一个非空单元格
For k = 2 To CS ''''''定义循环变量,k=2 到cs
Range("F" & k) = 1 ''''''单元格f&k的值为1
Next k '''''''循环执行K
Sub yy()
Dim Myr&, Myr2&, i&, Arr, Brr, r1,j&
Sheet1Activate '激活sheet1为当前活动工作表
Myr = Range("b65536")End(xlUp)Row 'myr等于 b列最后一行有记录的行号 ,b65536是b列最后一个单元格 End(xlUp)Row意思是最上面一条有记录的行 那也就是b列最后一行有记录的行号
Brr = Range("b6:h" & Myr) 'brr等于区域b6:h & myr myr是上面得到的 就是b列到h列 区域中 6行到下面最后一条有记录的行 的区域
Myr2 = Sheet3Range("b65536")End(xlUp)Row ' myr2等于sheet3的B列最后一行有记录行号
Arr = Sheet3Range("c6:h" & Myr2) 'arr等于sheet3的区域C6:H & MY2 这里和上面的B6:H & MYR一个意思
For i = 1 To UBound(Brr) 'I 走1 到 BRR数组的最大下界循环 就是把区域BRR里面所有的值遍历一遍
Set r1 = Sheet3[b:b]Find(Brr(i, 1), , , 1) '在区域Sheet3[b:b]查找Brr(i, 1) ,一个个查找的意思
If Not r1 Is Nothing Then '如果结果不是空
For j = 2 To 7 'j 走2 到7循环
Brr(i, j) = Arr(r1Row - 5, j - 1) '区域brr里面的第i行第j列) 等于 arr里面的第r1Row - 5行第j - 1列
Next
End If
Next
[b6]Resize(UBound(Brr), 7) = Brr ' B6往下UBound(Brr)行(brr的最大下界) 左7列的区域等于BRR
MsgBox "程序结束" '程序结束
End Sub
写的乱 我总结一下大概这代码的意思就是在SHEET1和SHEET3里面的两个区域里面查找 如果SHEET1的B列的数据在SHEET3B列数据存在
那么就把SHEET3里面对应行所在的C:H的数据复制到SHEET1里面对应的区域来
1是B列最后一个非空单元格行号,ROW即行;
2即单元格区域B3:C最后一行,如C列最后一行是第10行,那么Range("B3:C"&b) 就是B3:C10单元格区域;copy到cells(j,2)是从这个单元格为顶点单元格与被copy 的区域一样大的区域,并不是一个单元格。
3 & 是连接符
Sub mysub()
Dim start As Double, sh As Worksheet, B As Integer, j As Integer ' 定义四个变量
start = Timer '记录起始时间
ApplicationScreenUpdating = False '不d出错误提示
ActiveSheetRange("b3:f65536") = "" '清空B到F列的数据
For Each sh In ThisWorkbookWorksheets '建立工作表循环
j = ActiveSheet[b65536]End(xlUp)Row + 1 '给J赋值为当前工作表B列最后一个非空单元格下一行
If shName <> "外在本就读花名册" Then '当工作表名不为外在本就读花名册时
B = sh[b65536]End(xlUp)Row '给B赋值为不是外在本就读花名册B列最后一个非空单元格行号
shRange("b3 :c" & B)Copy Sheets("外在本就读花名册")Cells(j, 2) ' 依次COPY数据到外在本就读花名册中
shRange("e3 :e" & B)Copy Sheets("外在本就读花名册")Cells(j, 4)
shRange("k3 :k" & B)Copy Sheets("外在本就读花名册")Cells(j, 6)
shRange("l3 :l" & B)Copy Sheets("外在本就读花名册")Cells(j, 5)
End If
Next
MsgBox "程序共执行了" & Timer - start & "秒!" '计算程序运行的时间
ApplicationScreenUpdating = True '恢复警告提示
End Sub
以上就是关于VBA的一段代码求注释,谢谢全部的内容,包括:VBA的一段代码求注释,谢谢、VBA程序中注释的内容被显示成什么色有语法错误的语句被显示成什么色、VBA代码求注释等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)