Excel高手VBA修改录制宏将公式结果选择性粘贴

Question

只有http://pan.baidu.com/s/1c0pkkZe

最好解析一下

Answer 1

代码及注释如下：
Sub main()
If [b19] = 0 Then Exit Sub'如果B19=0，退出程序
For i = 1 To 9
If Cells(20 + i, 12) = [b19] Then'依次判断21-29行，12列的值是否等于B19
[j13:O13].Copy'如果等于，则复制J13:O13的区域
Cells(20 + i, 13).Select'到21-29行，从13列开始的行中
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False'选择性粘贴，仅复制单元格的值
End If
Next
Application.CutCopyMode = False
End Sub

Answer 2

Sub xx()
Dim y
On Error Resume Next
y = Application.WorksheetFunction.Match(Range("b19"), Columns("L"), False)

Application.EnableEvents = False

If Cells(19, 2) <> "" Then Cells(y, 13) = Range("J13")

If Cells(19, 2) <> "" Then Cells(y, 14) = Range("k13")

If Cells(19, 2) <> "" Then Cells(y, 15) = Range("L13")

If Cells(19, 2) <> "" Then Cells(y, 16) = Range("M13")
If Cells(19, 2) <> "" Then Cells(y, 17) = Range("N13")
If Cells(19, 2) <> "" Then Cells(y, 18) = Range("O13")

Application.EnableEvents = True
End Sub

微调按钮指定这个宏

Answer 3

Sub aaa()
If [b19] = 0 Then Exit Sub
For i = 1 To 9
If Cells(20 + i, 12) = [b19] Then
[j13:O13].Copy
Cells(20 + i, 13).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next
Application.CutCopyMode = False
End Sub