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

2022年5月26日 · 2 分钟 · Vinkey

python-CAD绘制路基横断面

基于python的CAD路基横断面绘制 源代码 # _*_ coding:utf-8- _*_ from pyautocad import APoint, Autocad, aDouble import win32com.client import numpy as np """ 设计高程:(2)1654.0m 填土边坡与路堑边坡坡率:(1)填方上部1:1.2(高度≤8m),填方下部1:1.4(高度≤12m) ;挖方1:0.9(高度≤20m) 路基宽度:(2) 路面宽7.0米,硬路肩宽0.75米,土路肩宽0.75米 以下数据单位:m """ design_height = 1654.0 # 设计高程 slop_fill_up = 1.2 # 坡率填方上部(高度≤8m) slop_fill_down = 1.4 # 坡率填方下部(高度≤12m) slop_cut = 0.9 # 坡率挖方(高度≤20m) surface_width = 7.0 # 路面宽 hard_shoulder = 0.75 # 硬路肩宽 dirt_shoulder = 0.75 # 土路肩宽 ctfs = 10 # 出图坐标放缩倍数 distance_sections = 60 # 修改为出图时横断面桩号间距 # 连接excel读取数据 xlapp = win32com.client.Dispatch("Excel.Application") wb = xlapp.ActiveWorkbook ws = xlapp.ActiveWorkbook.ActiveSheet # points是原始地面点高程 ground_points = [] row = 2 while row <= 20: i = 6 # 左侧数据 j = 8 # 右侧数据 # 桩号点绘图坐标 x0 = 0 + (distance_sections * (row - 2))//3 y0 = ws.cells(row, 7).value p0 = APoint(x0, y0) pts = [] pts.append(p0) # 拾取左侧点数据 while i >= 1: try: y_ = ws.cells(row, i).value x_ = - ws.cells(row + 1, i).value pti = pts[0] + (x_, y_, 0) pts.insert(0, pti) except: pass i -= 1 # 拾取右侧点数据 while ws.cells(row, j).value: y_ = ws.cells(row, j).value x_ = ws.cells(row + 1, j).value ptj = pts[-1] + (x_, y_, 0) pts.append(ptj) j += 1 ground_points.append(pts) for i in pts: print(i) print("") row = row + 3 # 连接cad,并输出结果 acad = Autocad(create_if_not_exists=True) acad.prompt("connect with the Autocad successfully.") print("connect with the Autocad successfully.") dwg = acad.ActiveDocument "原始地面线" # 定义原始地面线 图层 ysdmx = acad.doc.layers.add("原始地面线") ysdmx.color = 7 ysdmx.LineWeight = 25 dwg.ActiveLayer = ysdmx # 绘制原始地面线,使用多段线(PLine) for line_pts in ground_points: pt = aDouble([j for i in line_pts for j in i * ctfs]) acad.model.AddPolyLine(pt).LineWeight = 25 "路基线" # 绘制路基线,所有横断面路基线按一样绘制,手动修改 # 生成路基线关键点坐标 orginal_middl_pts = [] pt0 = APoint(0, design_height) orginal_middl_pts.append(pt0) rightpts = [(surface_width/2, 0), (hard_shoulder, 0), (dirt_shoulder, 0), (0.6, - 0.6), (0.6, 0), (0.6, 0.6), (1, 0), (20 * slop_cut, 20)] leftpts = [(surface_width/2, 0), (hard_shoulder, 0), (dirt_shoulder, 0), (8 * slop_fill_up, 8), (2, 0), (12 * slop_fill_down, 12)] for i in leftpts: pti = orginal_middl_pts[0] - (i[0], i[1], 0) orginal_middl_pts.insert(0, pti) for j in rightpts: ptj = orginal_middl_pts[-1] + (j[0], j[1], 0) orginal_middl_pts.append(ptj) # 定义路基线 图层 ljx = acad.doc.layers.add("路基线") ljx.color = 1 ljx.LineWeight = 100 dwg.ActiveLayer = ljx # 绘制路基,使用多段线(PLine) pt = aDouble([i for j in orginal_middl_pts for i in j * ctfs]) ljx_drawn = acad.model.AddPolyLine(pt) ljx_drawn.LineWeight = 100 "道路中心线" # 得到坐标 # 定义图层属性 zxj = acad.doc.layers.add("道路中心线") zxj.color = 2 zxj.LineWeight = 25 try: acad.ActiveDocument.Linetypes.Load("ACAD_ISO10W100", "acadiso.lin") except: pass zxj.Linetype = "ACAD_ISO10W100" dwg.ActiveLayer = zxj # 绘制中线 zxj_drewn = acad.model.addline(ctfs * (pt0 - (0, 2, 0)), ctfs * (pt0 + (0, 2, 0))) zxj_drewn.LineWeight = 25 # [中心线、路基线]向右复制6次 for i in range(6): _ = ljx_drawn.copy() _.Move(APoint(0, 0), APoint(distance_sections * (i + 1), 0) * ctfs) del _ _ = zxj_drewn.copy() _.Move(APoint(0, 0), APoint(distance_sections * (i + 1), 0) * ctfs) "添加桩号标注" # 得到坐标 # 定义图层 zh = acad.doc.layers.add("桩号标注") dwg.ActiveLayer = zh # 添加注释 for i in range(7): text_string = "K58+%d" % (70 + 10 * i) insertpt = APoint((distance_sections * i), design_height - 7) * ctfs height = 2.5 * ctfs textobj = acad.model.addtext(text_string, insertpt, height) textobj.Alignment = 7 textobj.textalignmentpoint = insertpt

2022年5月24日 · 3 分钟 · Vinkey

zerotier虚拟局域网/内网穿透

zerotier创建虚拟局域网 zerotier是一个可以创建基于p2p的虚拟局域网,第一次使用只需安装软件登录网页管理虚拟ip,以后每次启动都可以和局域网内的设备通讯,路由器也可以安装。 可以实现的操作 利用ip远程电脑,高画质,网速稳定(利用微软的默认程序) 虚拟局域网文件共享(类似于上述远程) 打印机 设置流程 注册账号 打开zerotier注册账号,可以用其他账号登录。 下载对应客户端 各种操作系统都有对应软件,下载安装即可。 创建子网络 创建 加入 二次确认 查看/设置ip 开始使用 后续如果需要设置网络,可以通过官网页面登录,也可以通过my.zerotier.com登录设置,少了一个页面。 得到了局域网可以干什么,请参考上面写的用法。

2022年5月24日 · 1 分钟 · Vinkey