关于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
--------------------编程问答--------------------
对于这么繁琐又没有技术含量的东西,是不会有人给出代码的! 其实说也不难,前面两位也说的很清楚了,自己录制宏,然后做一些删减修改就行了
补充:.NET技术 , VB.NET