Excel-vba创建表及粘贴公式结果
VBA创建新表汇总子sheet结果 源代码 V1.0 Public Sub abs_and_average() On Error Resume Next '这样不会报错。下标越界 If IsEmpty(Worksheets("data")) Then Sheets.Add after:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = "data" Else Worksheets("data").UsedRange.ClearContents End If insertline=0 For Each usedsheet In Worksheets: insertline=insertline+1 If usedsheet.Range("b12") = "Cd3" Then usedsheet.Range("w14").FormulaR1C1 = "齿轮箱输入转速(r/min)的绝对值" usedsheet.Range("p10").FormulaR1C1 = "输入轴转速" '单元格输入公式，相对引用（可以通过录制宏进行修改替换） usedsheet.Range("w15").FormulaR1C1 = "=abs(RC[-1])" '判断需要填充多长，这里从第30行开始向后循环判断非空单元格 i = 30 While usedsheet.Cells(i + 1, 10) <> "" i = i + 1 Wend cc = "w15:v" & i '使用range的方法，向下填充，还有其他功能，可以通过录制宏查看 usedsheet.Range(cc).FillDown usedsheet.Range("q10").Formula = "=AVERAGE(U3964:U5014)" '把平均值输出到汇总表 Worksheets("data").cells(insertline,1)=split(usedsheet.name,"=")(0) Worksheets("data").cells(insertline,2)=split(usedsheet.name,"=")(1) Worksheets("data").cells(insertline,3)=usedsheet.Range("Q10").value Else End If Next ' 显示适当列宽 Worksheets("data").range("A:c").EntireColumn.AutoFit Worksheets("data").Sort.SortFields.Clear Worksheets("data").Sort.SortFields.Add2 Key:=Range("B1:B20"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With Worksheets("data").Sort .SetRange Range("A1:C20") .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub V2.0 Public Sub abs_and_average0528() On Error Resume Next '这样不会报错。下标越界 If IsEmpty(Worksheets("data")) Then Sheets.Add after:=Sheets(Sheets.Count) Sheets(Sheets.Count).Name = "data" Else Worksheets("data").UsedRange.ClearContents End If insertline=0 For Each usedsheet In Worksheets: insertline=insertline+1 If usedsheet.Range("b10") = "Cd3" Then '判断需要目标行数，这里从第30行开始向后循环判断非空单元格 i = 30 While Cells(i+1, 10) <> "" i = i + 1 Wend cc = "u12:x" & i usedsheet.range(cc).clear '单元格输入文字 usedsheet.Range("U12").FormulaR1C1 = "发电机转速（r/min）" usedsheet.Range("v12").FormulaR1C1 = "齿轮箱输入转速(r/min)" usedsheet.Range("w12").FormulaR1C1 = "【绝对值】发电机转速（r/min）" usedsheet.Range("x12").FormulaR1C1 = "【绝对值】齿轮箱输入转速(r/min)" '单元格输入公式，相对引用 usedsheet.Range("U13").FormulaR1C1 = "=RC[-1]*60/2/3.1415926" usedsheet.Range("V13").FormulaR1C1 = "=RC[-19]*60/2/3.1415926" '单元格输入公式，直接输入内容 usedsheet.Range("w13").Formula = "=abs(u13)" usedsheet.Range("x13").Formula = "=abs(v13)" '判断需要填充多长，这里从第30行开始向后循环判断非空单元格 i = 30 While usedsheet.Cells(i + 1, 10) <> "" i = i + 1 Wend cc = "u13:x" & i '使用range的方法，向下填充，还有其他功能，可以通过录制宏查看 usedsheet.Range(cc).FillDown usedsheet.Range("w11").Formula = "=AVERAGE(w1412:w50012)" usedsheet.Range("x11").Formula = "=AVERAGE(x1412:x50012)" '把平均值输出到汇总表 Worksheets("data").cells(1,1)= "sheet name" Worksheets("data").cells(1,2)="【绝对值】发电机转速（r/min）" Worksheets("data").cells(1,3)="【绝对值】齿轮箱输入转速(r/min)" Worksheets("data").cells(insertline+1,1)=usedsheet.name Worksheets("data").cells(insertline+1,2)=usedsheet.Range("w11").value Worksheets("data").cells(insertline+1,3)=usedsheet.Range("x11").value Else End If Next ' 显示适当列宽 Worksheets("data").range("A:c").EntireColumn.AutoFit ' Worksheets("data").Sort.SortFields.Clear ' Worksheets("data").Sort.SortFields.Add2 Key:=Range("B1:B20"), _ ' SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal ' With Worksheets("data").Sort ' .SetRange Range("A1:C20") ' .Header = xlGuess ' .MatchCase = False ' .Orientation = xlTopToBottom ' .SortMethod = xlPinYin ' .Apply ' End With End Sub