• VBA源代码，根据某列中的最大值，拿到该行的行号。此代码为取出若干小区的信息，7*24小时，拿到某列值最大的行号，精简成7行
• '汇总每个sheet的结果,最大值,最小值之类的 Dim arr, dic, colh, rowh Dim i%, j%, k% Dim rmax(), rmin(), rrange(), rmaxamongpulley(), rminamongpulley(), rmaxamongeachrun(), rminamongeachrun()...

Sub sum_table()
'汇总每个sheet的结果,最大值,最小值之类的
Dim arr, dic, colh, rowh
Dim i%, j%, k%
Dim rmax(), rmin(), rrange(), rmaxamongpulley(), rminamongpulley(), rmaxamongeachrun(), rminamongeachrun() As Double
Dim coln, rown As Integer, n As Integer, m As Integer

'ActiveSheet.name = "sum"

n = Worksheets.Count
For k = 3 To n
g = Worksheets("content").Cells(k - 2, 1).Value
coln = Worksheets(g).UsedRange.Columns.Count
coln = Worksheets(g).[IV1].End(xlToLeft).Column
rown = Worksheets(g).UsedRange.Rows.Count

colnsum = Worksheets("sum").[IV1].End(xlToLeft).Column + 1

'取列头,并去重
Set dic = CreateObject("scripting.dictionary")
Worksheets(g).Activate
arr = ActiveSheet.Range(Cells(2, 1), Cells(2, coln))
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
dic(arr(i, j)) = ""
Next j
Next i
rowh = Application.Transpose(dic.keys)

Set dic = Nothing
'取行头,并去重
Set dic = CreateObject("scripting.dictionary")
Worksheets(g).Activate
arr = ActiveSheet.Range(Cells(3, 1), Cells(3, coln))
For i = 1 To UBound(arr)
For j = 1 To UBound(arr, 2)
dic(arr(i, j)) = ""
Next j
Next i
colh = dic.keys

Worksheets("sum").Activate
Range(Cells(2 + 1 * (UBound(rowh) + 1), colnsum).Address).Resize(UBound(rowh), 1) = rowh
Range(Cells(2 + 2 * (UBound(rowh) + 1), colnsum).Address).Resize(UBound(rowh), 1) = rowh

Range(Cells(1 + 0 * (UBound(rowh) + 1), 1 + colnsum).Address).Resize(1, UBound(colh) + 1) = colh
Range(Cells(1 + 1 * (UBound(rowh) + 1), 1 + colnsum).Address).Resize(1, UBound(colh) + 1) = colh
Range(Cells(1 + 2 * (UBound(rowh) + 1), 1 + colnsum).Address).Resize(1, UBound(colh) + 1) = colh

Set dic = Nothing
'根据行头,列头取最大值
ReDim rmax(1 To UBound(rowh), 1 To UBound(colh) + 1)
ReDim rmin(1 To UBound(rowh), 1 To UBound(colh) + 1)
ReDim rrange(1 To UBound(rowh), 1 To UBound(colh) + 1)
ReDim Preserve rmaxamongpulley(1 To n - 2, 1 To UBound(colh) + 1)
ReDim Preserve rminamongpulley(1 To n - 2, 1 To UBound(colh) + 1)

Worksheets(g).Activate
For i = 0 To UBound(colh)
For j = 1 To UBound(rowh)
For m = 1 To coln
If colh(i) = Worksheets(g).Cells(3, m).Value And rowh(j, 1) = Worksheets(g).Cells(2, m).Value Then
rmax(j, i + 1) = WorksheetFunction.Max(ActiveSheet.Range(Cells(5, m), Cells(rown, m)))
rmin(j, i + 1) = WorksheetFunction.Min(ActiveSheet.Range(Cells(5, m), Cells(rown, m)))
rrange(j, i + 1) = rmax(j, i + 1) - rmin(j, i + 1)
End If
Next
Next
rmaxamongpulley(k - 2, i + 1) = WorksheetFunction.Max(WorksheetFunction.Index(rmax, 0, i + 1))
rminamongpulley(k - 2, i + 1) = WorksheetFunction.Min(WorksheetFunction.Index(rmin, 0, i + 1))
Next

Worksheets("sum").Activate
Range(Cells(2 + 0 * (UBound(rowh) + 1), 1 + colnsum).Address).Resize(UBound(rowh), UBound(colh) + 1) = rmax
Range(Cells(2 + 1 * (UBound(rowh) + 1), 1 + colnsum).Address).Resize(UBound(rowh), UBound(colh) + 1) = rmin
Range(Cells(2 + 2 * (UBound(rowh) + 1), 1 + colnsum).Address).Resize(UBound(rowh), UBound(colh) + 1) = rrange

Worksheets("sum").Cells(1 + 0 * (UBound(rowh) + 1), colnsum).Value = g & "-max"
Worksheets("sum").Cells(1 + 1 * (UBound(rowh) + 1), colnsum).Value = g & "-min"
Worksheets("sum").Cells(1 + 2 * (UBound(rowh) + 1), colnsum).Value = g & "-range"
Next

ReDim rmaxamongeachrun(1 To UBound(colh) + 1)
ReDim rminamongeachrun(1 To UBound(colh) + 1)
For i = 1 To UBound(rmaxamongpulley, 2)
rmaxamongeachrun(i) = WorksheetFunction.Max(WorksheetFunction.Index(rmaxamongpulley, 0, i))
rminamongeachrun(i) = WorksheetFunction.Min(WorksheetFunction.Index(rminamongpulley, 0, i))
Next

Worksheets("sum").Activate
For k = 3 To n
g = Worksheets("content").Cells(k - 2, 1).Value
Range(Cells(2 + 3 * (UBound(rowh) + 1) + k - 3, 2).Address).Resize(1, 1) = g
Range(Cells(2 + 3 * (UBound(rowh) + 1) + k - 3 + n, 2).Address).Resize(1, 1) = g
Next

Range(Cells(1 + 3 * (UBound(rowh) + 1), 3).Address).Resize(1, UBound(colh) + 1) = colh
Range(Cells(1 + 3 * (UBound(rowh) + 1) + n, 3).Address).Resize(1, UBound(colh) + 1) = colh

Range(Cells(2 + 3 * (UBound(rowh) + 1), 3).Address).Resize(UBound(rmaxamongpulley), UBound(rmaxamongpulley, 2)) = rmaxamongpulley
Range(Cells(2 + 3 * (UBound(rowh) + 1) + n, 3).Address).Resize(UBound(rminamongpulley), UBound(rminamongpulley, 2)) = rminamongpulley
Range(Cells(3 + 5 * (UBound(rowh) + 1), 3).Address).Resize(1, UBound(rmaxamongeachrun)) = rmaxamongeachrun
Range(Cells(4 + 5 * (UBound(rowh) + 1), 3).Address).Resize(1, UBound(rminamongeachrun)) = rminamongeachrun

Worksheets("sum").Cells(1 + 3 * (UBound(rowh) + 1), 2).Value = "max among pulley"
Worksheets("sum").Cells(1 + 3 * (UBound(rowh) + 1) + n, 2).Value = "min among pulley"
Worksheets("sum").Cells(4 * (UBound(rowh) + 1), 2).Value = "max among run"
Worksheets("sum").Cells(4 * (UBound(rowh) + 1) + n, 2).Value = "min among run"

End Sub

展开全文
• 自定义查找最大值函数findMax()，功能：查找给定区域内的最大值（按字典排序，数字小于字母，大写字母小于小写字母）代码：Function findMax(ByVal rng As Range) '求最大值 Dim max As Variant max = rng.Cells(1)....
自定义查找最大值函数findMax()，功能：查找给定区域内的最大值（按字典排序，数字小于字母，大写字母小于小写字母）

代码：
Function findMax(ByVal rng As Range)
'求最大值
Dim max As Variant
max = rng.Cells(1).Value

For Each ce In rng
If ce.Value > max Then
max = ce.Value
End If
Next
findMax = max
End Function
局限性：
和Excel自带的Max()函数相比，运算速度明显偏慢。但是，Excel自带的max()只能返回一组数字中的最大值，而自定义的findMax函数不限制单元格内的数据类型。
展开全文
• Sub dataProcess() On Error Resume Next For j = 3 To 20 Max = WorksheetFunction.Max(Range(Cells(2, j), Cells(4072, j))) Min = WorksheetFunction.Min(Range... 用python还得换软件，VBA用熟了真的挺香。
Sub dataProcess()
On Error Resume Next
For j = 3 To 20
Max = WorksheetFunction.Max(Range(Cells(2, j), Cells(4072, j)))
Min = WorksheetFunction.Min(Range(Cells(2, j), Cells(4072, j)))
For i = 2 To 4072
Cells(i, j) = (Cells(i, j) - Min) / (Max - Min)
Next
Next
End Sub
j是列数，i是行数
总行/列数也可以使用代码自动读取（num = ActiveSheet.UsedRange.Rows.Count）
ps. 用python还得换软件，VBA用熟了真的挺香。
展开全文
• EXCELVBA贝塞尔曲线及插值:根据其中采用的算法， 进一步增添根据 X坐标求 Y坐标， 或根据 Y坐标求X坐标，更切合实际需求
• 展开全部公式：b10输入=CONCATENATE(LARGE(A1:A10,1),",",LARGE(A1:A10,2),",",LARGE(A1:A10,3),",",LARGE(A1:A10,4))，然后向下填充即可vba：Sub宏1()Fori=10ToRange("a65536").End(xlUp).Rowss=""Forj=1To4Ifss&l....

展开全部
公式：b10 输入 =CONCATENATE(LARGE(A1:A10,1),",", LARGE(A1:A10,2),",", LARGE(A1:A10,3),",", LARGE(A1:A10,4)) ，然后向下填充即可
vba：Sub 宏1()
For i = 10 To Range("a65536").End(xlUp).Row
ss = ""
For j = 1 To 4
If ss <> "" Then ss = ss & ","
ss = ss & Application.WorksheetFunction.Large(Range(Cells(i - 9, 1), Cells(i, 1)), j)
Next
Cells(i, 2) = ss
Next
End Sub
额，没注意有重复值，修32313133353236313431303231363533e58685e5aeb931333335333662改如下：Sub 宏1() '关键在于large函数不区分重复数
Dim m(3), k      'm用来存储4个最大数
For i = 10 To Range("a65536").End(xlUp).Row  '循环10到最后有数据的行
k = 2
m(0) = Application.WorksheetFunction.Large(Range(Cells(i - 9, 1), Cells(i, 1)), 1)  '第1大的数
For j = 1 To 3
m(j) = Application.WorksheetFunction.Large(Range(Cells(i - 9, 1), Cells(i, 1)), k)  '第2大的数
Do While m(j) = m(j - 1)  '如果第2大的数与第1大的数相等
k = k + 1             '循环查找次大的数，直到和上一个最大数不等
if k>10 then exit do 'k超过10，large函数会报错
m(j) = Application.WorksheetFunction.Large(Range(Cells(i - 9, 1), Cells(i, 1)), k)
Loop
Next
Cells(i, 2) = Join(m, ",") '使用join函数用逗号连接4个数
Next
End Sub

展开全文
• 二维坐标轴 Sub Axis() Set sht = Worksheets("sheet1") Set chart1 = sht.ChartObjects("图表 1") ...'设置主坐标轴横坐标交叉的坐标轴 chart1.Chart.Axes(xlValue).CrossesAt = Min / 10 End Sub
• Sub 分类() Dim A Dim cnn, SQL\$ Set cnn = CreateObject("adodb.connection") Set RS = CreateObject("adodb.recordset") cnn.Open "Provider = Microsoft.ace.Oledb.12.0;Extended Properties =TEXT;...
• 取出很多小区的数据，比如说有7行，根据某列排序取出前4行的，然后每列按照这个平均。VBA通信领域的实际应用。
• Sub 获取最大行列区域() Dim Dim j i = Range("A" & Rows.Count).End(xlUp).Row '通过A1,获得使用的最大行 j = Cells(1, Columns.Count).End(xlToLeft).Column '通过A1,获得使用的最大列 Range(Cells(1, 1), ...
•  在cell中填充去掉的最大值,最小值, 总和,平均值和方差.  算法效率有点低,主要解决业务问题了. Public Sub aver()  Application.ScreenUpdating = False  Dim maxCount  maxCount = 10 //最大行数
• 程序可自动算出字段最大值，并以此值自动输出
• excel vba 获取行号
• rw.Cells(1, 11).FormulaArray = “=MAX(IF(打印记录!K:K=Sheet1!J” & rw.Row & “,打印记录!L:L))”
• 前言：这种题目在leetcode里就是简单难度，之前用Python写过一个...'自动算出一行连续为0的最大值 cal_row = InputBox("需要计算的开始行和结束行（如2,5）：") my_rows = VBA.Split(cal_row, ",") start_row =...
• EXCEL和VBA里默认的数值一般是int 尤其是VBA里int是很不够用的 int的数值范围很小，只支持 65535 ，稍微大一点的计算，可能就报错了，会显示 “数值溢出” 处理方法 clng(500000) randmize clng(1+(500000-1...
• One reason this helps is that if you’re updating (via VBA) several different ranges with new values, or copy / pasting from several ranges to create a consolidated table of data, you likely do not ...
• 返回一个 Long 型数据，其为指定的数组维可用的最大下标。 语法 UBound(arrayname[, dimension]) UBound 函数的语法包含下面部分： 部分 描述 arrayname 必需的。数组变量的名称，遵循标准变量命名...
• 技巧92 移除工作表的最小最大化和关闭按钮 12 技巧93 在工具栏上添加下拉列表框 12 技巧94 屏蔽工作表的复制功能 12 技巧95 禁用工具栏的自定义 12 技巧96 屏蔽所有的命令栏 12 技巧97 恢复Excel的命令栏 12 第8章 ...
• 库存分析 目标： 在Excel中使用VBA创建脚本，...涨幅最大的股票代码及其对应 百分比跌幅最大的股票代码及其对应 总交易量最大的股票代号及其对应 还创建了一个脚本，用于有条件地格式化“年度更改”的单元格内部
• 函数作用：查询某一第num次出现的................9 '3.函数作用：返回当个人工资薪金所得为2000元(起征点为850元)时的应纳个人所得税税额.............................10 '4.函数作用：从形如"123545ABCDE"的...
• 注意-有一个附加的“ VBA分析财务数据bonus.bas”脚本，其中包括上述内容以及以下内容：最大百分比增长，最大百分比下降和最大总交易量。 还将重复浏览Excel文件中的每个工作表 特征 VBA脚本执行以下操作： 遍历...
• VBA挑战进行股票市场分析 背景 一个VBA脚本项目，用于分析实际股票市场数据。 该分析使用了两个数据点，一个... 作为奖励，脚本在每年的所有股票代码中输出“最大百分比增长”，“最大百分比下降”和“最大总交易量”。
• 想问一下各位，这段vba代码中的循环和引用两个问题如何解决？
• 用代码实现--也要思考和学习下，万一没轮子也得自己会思考着一步步造起来 ... ...一 数学上的最大公约数 ...定义：指两个或多个整数共有...最大公约数：也称最大公因数，最大公因子 数学上写法 (A, B) https://bai...
• ## Vba菜鸟教程

万次阅读 多人点赞 2020-05-02 18:21:15
文章目录Vba菜鸟教程编辑器宏vba基本语法运算符变量语句简写语句sub语句调用语句退出语句分支语句循环语句判断语句公式与函数在单元格输入公式利用单元格公式返回值调用工作表函数利用vba函数自定义函数操作对象操作...
• ## VBA调用Shell

千次阅读 2021-08-28 15:32:59
VBA中执行Shell介绍，打开应用，执行python、bat、mysql；
• 最近在分析多个sheet表的数据发现要求一系列数据的平均,很是麻烦,下面给出VBA的调用代码 在Excel中按下Alt+F11调出VBA编辑器,然后点击插入一个模块,运行代码求平均 Sub vba计算平均() Start = 19 For x...
• ABCDE正确应为ItemLocationLPpcs3920125001MAFLP326210123920123403MAFLP28896224039125806MAFLP06287132874123601MAFLP15106114045125803MAFLP062541116125805MAFLP0627611403912580...A B C D...

...