VBA-Excel重心法求解最优地址

刚刚学习VBA，于是做了一个小运算，用重心法求解最优地址

1.做出的模板界面如下图所示,通过点击按钮，就可以计算得到我们想要的结果

Option Explicit

Sub

2.接下来，我们来看一个具体实例，在空白的数据区域填上我们的数据。然后点击相应的按钮，我们就可以得到我们所需的数据

3，不想要迭代的过程，可以直接按“求解”按钮，直接得出结果

4.具体代码如下：

Option ExplicitSub 计算目的坐标()
Dim h0, hn, i初始解
h0 = 运费(cells(7, 2), cells(8, 2), 8, 2)
hn = 下一个点(cells(7, 2), cells(8, 2))
While hn <= h0
迭代
i = h0
h0 = hn
hn = 下一个点(cells(7, 2), cells(8, 2))
WendEnd Sub
Sub 运乘量()
宏运费
End Sub
Sub later()
Dim h1
迭代
h1 = 下一个点(cells(7, 2), cells(8, 2))End Sub
Sub 初解()
Dim i, j
i = 2
While cells(1, i) <> ""
j = i - 1
cells(8 + i, 1).Value = "d" & j
cells(8 + i, 3).Value = "dn" & j
i = i + 1
Wend
cells(8 + 1 + i, 1) = "h"
cells(8 + 1 + i, 3) = "hn"
初始解
End SubFunction 宏运费()
Dim i
i = 2While cells(1, i) <> ""cells(6, i) = cells(4, i) * cells(5, i)i = i + 1WendEnd Function
Function 初始解()
'根据公式算出初始解
Dim i, sum, chu, x0, y0
i = 2
sum = 0
chu = 0
While cells(1, i) <> ""sum = sum + cells(2, i) * cells(6, i)
chu = chu + cells(6, i)
i = i + 1
Wend
x0 = sum / chu
i = 2
sum = 0
chu = 0
While cells(1, i) <> ""sum = sum + cells(3, i) * cells(6, i)
chu = chu + cells(6, i)
i = i + 1
Wend
'将结果显示在对应的单元格上
y0 = sum / chu
cells(7, 2) = x0
cells(8, 2) = y0
End Function
'计算此时的运费
Function 运费(x0, y0, a, b)
Dim i, h, j
i = 2
While cells(1, i) <> ""
cells(a + i, b) = Sqr((cells(2, i) - x0) * (cells(2, i) - x0) + (cells(3, i) - y0) * (cells(3, i) - y0))
i = i + 1
Wend
j = 2While cells(1, j) <> ""h = cells(6, j) * cells(a + j, b) + h
j = j + 1
Wend
cells(a + i + 1, b) = h
运费 = hEnd Function
'用公式计算下一个坐标点
Function 下一个点(x0, y0)Dim x, y, h0, h, sum, chu, i, mi = 2
While cells(1, i) <> ""
cells(8 + i, 2) = Sqr((cells(2, i) - x0) * (cells(2, i) - x0) + (cells(3, i) - y0) * (cells(3, i) - y0))
i = i + 1
Wend
i = 2
sum = 0
chu = 0
While cells(1, i) <> ""sum = sum + cells(2, i) * cells(6, i) / cells(8 + i, 2)
chu = chu + cells(6, i) / cells(8 + i, 2)
i = i + 1
Wend
x = sum / chu
i = 2
sum = 0
chu = 0
While cells(1, i) <> ""sum = sum + cells(3, i) * cells(6, i) / cells(8 + i, 2)
chu = chu + cells(6, i) / cells(8 + i, 2)
i = i + 1
Wend
y = sum / chu
h = 运费(x, y, 8, 4)i = 2
While cells(1, i) <> ""
cells(8 + i, 4) = Sqr((cells(2, i + 1) - x) * (cells(2, i + 1) - x) + (cells(3, i + 1) - y) * (cells(3, i + 1) - y))
i = i + 1
Wend
'将对应的数据显示在对应的单元格上
cells(7, 4) = x
cells(8, 4) = y
cells(8 + i + 1, 4) = hEnd Function
'进行迭代计算
Function 迭代()
Dim icells(7, 2) = cells(7, 4)
cells(8, 2) = cells(8, 4)
i = 2
While cells(1, i) <> ""
cells(8 + i, 2) = cells(8 + i, 4)i = i + 1
Wend
cells(8 + i + 1, 2) = cells(8 + i + 1, 4)End Function

VBA-Excel重心法求解最优地址相关推荐

VBA Excel 自定义函数不能调用成功的问题的解决方法
VBA Excel 自定义函数不能调用成功的问题的解决方法问题以及解决方案的列举(持续更新中) 问题以及解决方案的列举(持续更新中) 自定义函数是自动化各种Excel重复操作的重要函数,我们可以用它 ...
VBA Excel 单元格内多行内容的文字处理方法
VBA Excel 实现单元格内多行内容的文字处理方法在Excel中有很多的函数可以作用于单元格,但是其对单元格整体进行操作,因此单元格数据最好只有一行,这样Excel函数才能运行正确.但是有时候一 ...
如何利用excel批量提取域名IP地址？
今天跟大家分享一下如何利用excel批量提取域名IP地址? 1.首先我们打开Excel软件,录入要查询的域名并选中数据单元格区域 2.接着我们点击[DIY工具箱] 3.点击[更多]选择[查询域名的IP ...
EXCEL技巧 | 教你在EXCEL中搜索、核实地址数据
1 应用场景学习工作中,我们有时需要获取现实中的商铺.小区.饭店等地理数据,并整理到EXCEL表格中. 传统方法需要外采或通过一些专业地图网站去搜索和复制粘贴想要的数据,操作起来很不方便. 为此,笔 ...
[小O地图 EXCEL版] 经纬度坐标转地址文字
小O地图EXCEL版是基于EXCEL表格提供地理数据处理.地图可视化的工具软件.主要提供地址转坐标.坐标转地址等与地理数据处理相关的功能. 传统的地理数据处理需要使用专业的GIS软件完成,GIS软件的 ...
跑步锻炼（2020省赛）用Excel表格求解答案8879
题目描述本题为填空题,只需要算出结果后,在代码中使用输出语句将所填结果输出即可. 小蓝每天都锻炼身体. 正常情况下,小蓝每天跑 1 千米.如果某天是周一或者月初(1 日),为了激励自己,小蓝要跑 2 ...
vba 修改access表的链接地址_神奇的VBA编程：禁止修改Excel工作表名称
职场中经常需要将做好的Excel表格/模板发给他人或者存放在公共路径上共享使用,此时需要禁止别人更改已经设定好的工作表名称.或者某些工作簿中有公式使用了对某些工作表的外部引用,如果工作表名称发生变化, ...
excel制作跨职能流程图_用Excel规划求解工具，实现组合投资优化
营长说在很多情况下,企业可能面对多个投资项目,但由于资金限制不能全部进行投资,需要对这些项目进行取舍,实现组合投资优化.即在有限资金条件下,实现投资的收益最大化.Excel中的规划求解就可以快速实现 ...
[整理][VBA]Excel合并表格
1.支持多个工作簿指定名称工作表的合并 2.支持每个工作簿第一个工作表的合并(工作表名称不相同),自动排除空白的工作表 3.支持合并每个工作簿的所有工作表 Excel2019已测试通过 VBA源码: ...
Excel规划求解Solver：三种方法的区别
Excel Solver作为常用的最优解解决工具,在选择解决方法(solving method)的时候有三种选项,这三种选项有什么区别?什么时候该选择哪种方法?在本文做综合解释目录 1. GRG N ...

VBA-Excel重心法求解最优地址

VBA-Excel重心法求解最优地址相关推荐

最新文章

热门文章