当前位置:编程学习 > C#/ASP.NET >>

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

从朋友那得到以下程序,可以把图片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


--------------------编程问答--------------------  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的教程,对于写程序的人来说,这东西简直小菜一碟。 --------------------编程问答-------------------- 这个是录制宏产生的后再修改的

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
--------------------编程问答-------------------- 如果想实现下图的列表功能,我该如何修改此程序呢?


--------------------编程问答--------------------
引用 3 楼 linanNO1 的回复:
如果想实现下图的列表功能,我该如何修改此程序呢?



对于这么繁琐又没有技术含量的东西,是不会有人给出代码的! 其实说也不难,前面两位也说的很清楚了,自己录制宏,然后做一些删减修改就行了
补充:.NET技术 ,  VB.NET
CopyRight © 2012 站长网 编程知识问答 www.zzzyk.com All Rights Reserved
部份技术文章来自网络,