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

2013-07-12 10:29:28 313 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

linanno1 墨衍会员 · AI 创作全网分发关注 + 加入社区

99个Excel VBA经典函数源码大全 99个Excel 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

...全文

VBA经典应用69例应用7：从字符串中删除特定字符 VBA经典应用69例》（版权10178981），是我推出的第九套教程，教程是专门针对初级、中级学员在学习VBA过程中可能遇到的案例展开，这套教程案例众多，紧贴“实战”，并做“战术总结”，以便大家能很好的应用。教程的目的是要求大家。本套教程共三册六十九个专题，今日内容：VBA经典应用69例应用7：从字符串中删除特定字符。阅读详情

linanno1

VB 16,718 成员 110,520 内容

+ 关注 + 加入社区

切换为时间正序

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的教程，对于写程序的人来说，这东西简直小菜一碟。

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

相关推荐