关于VBA的经典问题---急！

linanno1 2013-07-12 10:29:28
从朋友那得到以下程序，可以把图片1转变为图片二，但本人对VB了解不深，图片3是我想举一反三的，还请各位大侠指教，此程序的具体意思是什么？特别是红色的部分，修改它我估计可以举一反三了，谢谢！

图片1：



图片2：



图片3--：




Sub iWearer()
Dim I, K
Application.ScreenUpdating = False
Cells.Select
Selection.UnMerge
I = Range("A65536").End(xlUp).Row

Rows(I).Select
Selection.Delete Shift:=xlUp
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A22").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(LEFT(RC[1],7)<>""Product"",RC[37]<>""""),""Y"","""")"
Range("A22").Select
Selection.Copy
Range("A1:A2").Resize(I - 1, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False

For K = 1 To I - 1
Range("A1").Offset(K, 0).Select
If Range("A1").Offset(K, 0).Value = "Y" Then
Selection.Delete Shift:=xlToLeft
End If
Next K

Columns("A:A").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("A1:I1").Select
Selection.EntireColumn.Insert , CopyOrigin:=xlFormatFromLeftOrAbove

ActiveWindow.Zoom = 85
Range("J1").Select
ActiveCell.FormulaR1C1 = "Product"
Range("A1").Select
ActiveCell.FormulaR1C1 = "Customer"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Wearer"
Range("C1").Select
ActiveCell.FormulaR1C1 = "WO"
Range("D1").Select

ActiveCell.FormulaR1C1 = "Reason"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Size"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Order"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Done"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Open"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Del.Date"
Range("J1").Select
ActiveWindow.SmallScroll ToRight:=-2
Range("A2").Select

Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(LEFT(RC[10],5)=""Custo"",TRIM(RC[14]),R[-1]C)"
Range("B2").Select
ActiveCell.FormulaR1C1 = "=IF(LEFT(R[-1]C[9],7)=""Wearer#"",RC[9],R[-1]C)"
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=IF(LEFT(RC[8],16)=""Workorder Number"",RC[17],R[-1]C)"
Range("D2").Select
ActiveCell.FormulaR1C1 = "=IF(LEFT(RC[7],10)=""Order date"",RC[27],R[-1]C)"
Range("E2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[5]<>"""",RC[25],"""")"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[4]<>"""",RC[35],"""")"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[3]<>"""",RC[37],"""")"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[2]<>"""",RC[38],"""")"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=IF(LEFT(RC[2],13)=""Delivery date"",RC[11],R[-1]C)"
Range("I3").Select
Range("A2:I2").Select
Selection.Copy
Range("A2:I2").Resize(I - 1, 9).Select

ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'GoTo 100


Columns("J:J").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("J1").Value = "Remark"
Range("J10").Select
ActiveCell.FormulaR1C1 = "=IF(RC[11]="""",R[-1]C,RC[11])"

Range("J10").Select
Selection.AutoFill Destination:=Range("J10").Resize(I - 9, 1)

Range("J10").Resize(I - 9, 1).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False

Range("A2:k2948").Resize(I, 11).Select



100
Selection.AutoFilter
ActiveSheet.Range("$A$2:$k$2948").Resize(I, 11).AutoFilter Field:=6, Criteria1:="="
Selection.EntireRow.Delete
Columns("L:AZ").Select
Selection.Delete Shift:=xlToLeft
Cells.Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Font.Bold = True
Selection.Font.Bold = False
Range("A2").Select

Application.ScreenUpdating = True

End Sub


...全文
239 4 打赏 收藏 转发到动态 举报
写回复
用AI写文章
4 条回复
切换为时间正序
请发表友善的回复…
发表回复
linanno1 2013-07-18
  • 打赏
  • 举报
 回复
如果想实现下图的列表功能，我该如何修改此程序呢？


sosoben 2013-07-18
  • 打赏
  • 举报
 回复
引用 3 楼 linanNO1 的回复:
如果想实现下图的列表功能，我该如何修改此程序呢？
对于这么繁琐又没有技术含量的东西，是不会有人给出代码的！ 其实说也不难，前面两位也说的很清楚了,自己录制宏，然后做一些删减修改就行了
vicanary 2013-07-12
  • 打赏
  • 举报
 回复
这个是录制宏产生的后再修改的 

ActiveWindow.Zoom = 85
    Range("J1").Select‘选择"J1"单元格
    ActiveCell.FormulaR1C1 = "Product"’将当前活动单元格集合的第一行第一列的值设置成“Product”
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Customer"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Wearer"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "WO"
    Range("D1").Select

    ActiveCell.FormulaR1C1 = "Reason"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Size"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Order"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Done"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Open"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Del.Date"
    Range("J1").Select
    ActiveWindow.SmallScroll ToRight:=-2
    Range("A2").Select
    
  Range("A2").Select'选择"A2"
    ActiveCell.FormulaR1C1 = "=IF(LEFT(RC[10],5)=""Custo"",TRIM(RC[14]),R[-1]C)"'如果相对当前单元格的下面第十行的单元格的值的前五位是“Custo”，则取相对于当前单元格的以下的第十四行的值，去除其左右空格，赋值给当前当前格；否则取当前单元格的上一行的值赋值给当前单元格。
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=IF(LEFT(R[-1]C[9],7)=""Wearer#"",RC[9],R[-1]C)"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(LEFT(RC[8],16)=""Workorder Number"",RC[17],R[-1]C)"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=IF(LEFT(RC[7],10)=""Order date"",RC[27],R[-1]C)"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[5]<>"""",RC[25],"""")"’如果当前单选格的下面五行的单元格的值是空值，则将下面第25个单元格的值赋值给当前单元格，否则设置为空
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[4]<>"""",RC[35],"""")"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[3]<>"""",RC[37],"""")"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[2]<>"""",RC[38],"""")"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=IF(LEFT(RC[2],13)=""Delivery date"",RC[11],R[-1]C)"
    Range("I3").Select
    Range("A2:I2").Select
    Selection.Copy
    Range("A2:I2").Resize(I - 1, 9).Select
threenewbee 2013-07-12
  • 打赏
  • 举报
 回复
ActiveWindow.Zoom = 85 活动窗口的缩放比例设置为 85% Range("J1").Select 选择J1单元格 ActiveCell.FormulaR1C1 = "Product" 输入公式Product（事实上这里是常量字符串） Range("A1").Select 选择A1单元格 ... ActiveCell.FormulaR1C1 = "=IF(LEFT(RC[10],5)=""Custo"",TRIM(RC[14]),R[-1]C)" 这个就是公式了，IF，如果，LEFT取得字符串左边文本，RC[10]，相对本单元格的同一行第10列，TRIM截取文本左右两边的空格。 很显然，这些代码都是通过Excel的“录制宏”自动产生再复制粘贴的，你不必深究。至于Excel的公式怎么用，这个可以看Excel的教程，对于写程序的人来说，这东西简直小菜一碟。
零基础学Excel VBA
零基础学Excel VBA...这是对VBA基础的学习．一步一步来，不要急，有一天会有柳暗花明的一天．
SQL语言与excel。VBA结和
EXCEL(VBA)~SQL 经典写法范本汇集(一) 2007-12-10 21:20 编前话：为了更系统的学习sql语句，小爪首次系统的汇集sql 需引用 microsoft activeX Data Objects 2.8 library 1.sql = "select 构件名称,构件代号,横长度,...
VBA零基础入门
讲师：童大谦 图书《代替VBA！用Python轻松实现Excel编程》和《对比VBA学Python 高xiao实现数据处理自动化》作者。 致力于Office和WPS Office办公自动化，提供VBA和Python全系列视频课程。熟悉Power BI, Python, R,...
geokit2012免费版地球化学数据处理程序.rar
请您再检查一下，如果还没有关闭，现在关闭还来得急!!!geokit是免费软件，您可以以任何方式复制、传播本软件，也可以向您的朋友及同事推荐使用本软件。您在使用本程序进行数据处理后发表，请将一个用VBA构建的地球...
SQL语言与excel使用方法
EXCEL里使用SQL的方法（欢乐小爪原创） 急用EXCEL的SQL用法，抄来欢乐小爪几篇文章，支持原创，留下小爪印：http://hi.baidu.com/huanhuanxiaozhua/blog EXCEL(VBA)~SQL 经典写法范本汇集(一)
VB

16,555

社区成员

110,528

社区内容

发帖
与我相关
我的任务
社区描述
VB技术相关讨论，主要为经典vb，即VB6.0
社区管理员
  • VB.NET
  • 水哥阿乐
  • 无·法
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章