怎么用VBA 将公式 改为文本或VBA代码 把第一张图的内容，做成第二张图的效果

来源：蜘蛛抓取(WebSpider) 时间：2018-03-14 05:19 标签： VBA 将公式 改为文本
查看: 3093|回复: 74
想请教个问题，把所有相互关联的公式换成VBA代码执行，速度为什么慢了？
阅读权限70
在线时间 小时
我的表中，有25个单元格有不同的相关联的公式，为了优化，我把他们都改成相应的宏代码，本以为换成宏执行速度会变快，但是发现在通过change事件，将所有这25个单元格中的数据被分别计算出来并放入单元格中时，反而有停顿，而原来使用公式却显得运行很顺畅，这是怎么回事？因为数据太多，不方便发附件，请高人指点，谢谢
阅读权限50
在线时间 小时
无图无附件无真相
阅读权限95
在线时间 小时
估计没有关闭触发事件。
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.EnableEvents = True
阅读权限70
在线时间 小时
估计没有关闭触发事件。
Private Sub Worksheet_Change(ByVal Target As Range)
应该不是，比如我 “现金” 中的数一改变，这25个公式都会自动算出相应的数，而换成宏后，也一样执行一大堆代码，分别计算出25个数放入相应单元格中，所以当初想用宏代替这些公式时我就预感到可能会慢。而用公式反而很快，没有停顿的痕迹。
阅读权限70
在线时间 小时
估计没有关闭触发事件。
Private Sub Worksheet_Change(ByVal Target As Range)Sub DataInfo()
Dim a%, i%, j%, n%, SetRows1%, SetRows2%, SetRows3%, SetRows4%, MyPath$, srr, dd, H
lab1 = True
Application.ScreenUpdating = False
a = Cells(Rows.Count, &a&).End(3).Row
n = 0
For i = a To 1 Step -1
& & If Cells(i, &a&) = &可融资资金& Then
& && &&&SetRows4 = i
& & ElseIf Cells(i, &a&) = &合计& Then
& && &&&n = n + 1
& && &&&If n = 1 Then SetRows3 = i
& & ElseIf Cells(i, &a&) = &成交股数& Then
& && &&&SetRows2 = i
& & ElseIf Cells(i, &a&) = &融资负债及费用合计& Then
& && &&&SetRows1 = i
& && &&&Exit For
& & End If
Next i
Set dd = CreateObject(&scripting.dictionary&)
MyPath = &C:\Users\bjyfcx\Documents&
Workbooks.OpenText MyPath & &d0.txt&
With ActiveWorkbook
& & srr = .Sheets(1).Range(&A3&).CurrentRegion
& & .Close 0
End With
For i = 2 To UBound(srr)
& & dd(srr(i, 2)) = srr(i, 3)
Next
Call RZ_DataInfo
'担保证券市值
Cells(5, &a&) = (Cells(3, &a&) - Cells(SetRows2 + 2, &h&) - Cells(SetRows2 + 2, &i&) - Cells(SetRows2 + 2, &j&) - Cells(SetRows2 + 2, &k&) - Cells(SetRows2 + 6, &k&) - Cells(SetRows2 + 10, &k&) - Cells(SetRows2 + 14, &k&) - Cells(SetRows2 + 18, &k&)) * Cells(3, &c&) _
+ Cells(SetRows2 + 2, &h&) * Cells(SetRows2 + 1, &h&) + Cells(SetRows2 + 2, &i&) * Cells(SetRows2 + 1, &i&) + Cells(SetRows2 + 2, &j&) * Cells(SetRows2 + 1, &j&) + Cells(SetRows2 + 2, &k&) * Cells(SetRows2 + 1, &k&) + Cells(SetRows2 + 6, &k&) * Cells(SetRows2 + 5, &k&) _
+ Cells(SetRows2 + 10, &k&) * Cells(SetRows2 + 9, &k&) + Cells(SetRows2 + 14, &k&) * Cells(SetRows2 + 13, &k&) + Cells(SetRows2 + 18, &k&) * Cells(SetRows2 + 17, &k&) + IIf(Cells(SetRows4 - 1, &j&).Value = &&, 0, Cells(SetRows4 - 1, &j&).Value)
'担保资产
Cells(3, &b&) = Cells(5, &a&) + Cells(5, &f&)
'我的市值
Cells(5, &b&) = Cells(5, &a&) - Cells(3, &d&)
'净资产
Cells(5, &c&) = Cells(5, &b&) + Cells(5, &f&)
'可转出资产
Cells(3, &e&) = IIf(Cells(3, &b&) - Cells(3, &d&) * 3 & 0, 0, Cells(3, &b&) - Cells(3, &d&) * 3)
'维持担保比例
Cells(3, &f&) = IIf(Cells(3, &d&) = 0, -1, Round((Cells(5, &a&) + Cells(5, &f&)) / Cells(3, &d&), 2))
'每日利息
If Cells(9, &a&) = &未清算& Then
& & Cells(5, &e&) = Round((Cells(SetRows1 + 1, &a&) + IIf(Cells(SetRows1 + 1, &g&) = &&, 0, Cells(SetRows1 + 1, &g&)) - IIf(Cells(SetRows2 - 3, &a&).Value = &&, 0, Cells(SetRows2 - 3, &a&).Value) - IIf(Cells(SetRows2 - 3, &d&).Value = &&, 0, Cells(SetRows2 - 3, &d&).Value)) * 0.0835 / 360, 2)
Else
& & Cells(5, &e&) = Round(Cells(SetRows1 + 1, &a&) * 0.0835 / 360, 2)
End If
'融资证券市值折算
Cells(7, &c&) = sumbypz(Range(&C11:C& & SetRows1), &&, -1) * Cells(3, &c&) * dd(&恒宝股份&) + sumbypz(Range(&C11:C& & SetRows1), Cells(SetRows2, &h&), -1) * Cells(SetRows2 + 1, &h&) * dd(Cells(SetRows2, &h&).Value) _
+ sumbypz(Range(&C11:C& & SetRows1), Cells(SetRows2, &i&), -1) * Cells(SetRows2 + 1, &i&) * dd(Cells(SetRows2, &i&).Value) + sumbypz(Range(&C11:C& & SetRows1), Cells(SetRows2, &j&), -1) * Cells(SetRows2 + 1, &j&) * dd(Cells(SetRows2, &j&).Value)
'自有证券市值折算
Cells(7, &a&) = (Cells(3, &a&) - Cells(SetRows2 + 2, &h&) - Cells(SetRows2 + 2, &i&) - Cells(SetRows2 + 2, &j&) - Cells(SetRows2 + 2, &k&) - Cells(SetRows2 + 6, &k&) - Cells(SetRows2 + 10, &k&) - Cells(SetRows2 + 14, &k&) - Cells(SetRows2 + 18, &k&)) * Cells(3, &c&) * dd(&恒宝股份&) _
+ Cells(SetRows2 + 2, &h&) * Cells(SetRows2 + 1, &h&) * dd(Cells(SetRows2, &h&).Value) + Cells(SetRows2 + 2, &i&) * Cells(SetRows2 + 1, &i&) * dd(Cells(SetRows2, &i&).Value) + Cells(SetRows2 + 2, &j&) * Cells(SetRows2 + 1, &j&) * dd(Cells(SetRows2, &j&).Value) _
+ Cells(SetRows2 + 2, &k&) * Cells(SetRows2 + 1, &k&) * dd(Cells(SetRows2, &k&).Value) + Cells(SetRows2 + 6, &k&) * Cells(SetRows2 + 5, &k&) * dd(Cells(SetRows2 + 4, &k&).Value) + Cells(SetRows2 + 10, &k&) * Cells(SetRows2 + 9, &k&) * dd(Cells(SetRows2 + 8, &k&).Value) _
+ Cells(SetRows2 + 14, &k&) * Cells(SetRows2 + 13, &k&) * dd(Cells(SetRows2 + 12, &k&).Value) + Cells(SetRows2 + 18, &k&) * Cells(SetRows2 + 17, &k&) * dd(Cells(SetRows2 + 16, &k&).Value) - Cells(7, &c&)
'融资盈利
For i = 11 To SetRows1 - 1
& & If Cells(i, &c&) = && Then
& && &&&H = H + Cells(i, &c&).Offset(0, -2)
& & End If
Next i
If sumbypz(Range(&C11:C& & SetRows1), &&, -1) * Cells(3, &c&) - sumbypz(Range(&A11:A& & SetRows1), &&, 1) + H & 0 Then
& & Cells(7, &b&) = (sumbypz(Range(&C11:C& & SetRows1), &&, -1) * Cells(3, &c&) - sumbypz(Range(&A11:A& & SetRows1), &&, 1) + H) * dd(&恒宝股份&)
Else
& & Cells(7, &b&) = sumbypz(Range(&C11:C& & SetRows1), &&, -1) * Cells(3, &c&) - sumbypz(Range(&A11:A& & SetRows1), &&, 1) + H
End If
If Cells(SetRows2 + 2, &h&) && 0 Then
& & If sumbypz(Range(&C11:C& & SetRows1), Cells(SetRows2, &h&), -1) * Cells(SetRows2 + 1, &h&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &h&), 1) & 0 Then
& && &&&Cells(7, &b&) = Cells(7, &b&) + (sumbypz(Range(&C11:C& & SetRows1), Cells(SetRows2, &h&), -1) * Cells(SetRows2 + 1, &h&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &h&), 1)) * dd(Cells(SetRows2, &h&).Value)
& & Else
& && &&&Cells(7, &b&) = Cells(7, &b&) + sumbypz(Range(&C11:C& & SetRows1), Cells(SetRows2, &h&), -1) * Cells(SetRows2 + 1, &h&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &h&), 1)
& & End If
ElseIf Cells(SetRows2 + 2, &i&) && 0 Then
& & If sumbypz(Range(&C11:C& & SetRows1), Cells(SetRows2, &i&), -1) * Cells(SetRows2 + 1, &i&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &i&), 1) & 0 Then
& && &&&Cells(7, &b&) = Cells(7, &b&) + (sumbypz(Range(&C11:C& & SetRows1), Cells(SetRows2, &i&), -1) * Cells(SetRows2 + 1, &i&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &i&), 1)) * dd(Cells(SetRows2, &i&).Value)
& & Else
& && &&&Cells(7, &b&) = Cells(7, &b&) + sumbypz(Range(&C11:C& & SetRows1), Cells(SetRows2, &i&), -1) * Cells(SetRows2 + 1, &i&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &i&), 1)
& & End If
ElseIf Cells(SetRows2 + 2, &j&) && 0 Then
& & If sumbypz(Range(&C11:C& & SetRows1), Cells(SetRows2, &j&), -1) * Cells(SetRows2 + 1, &j&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &j&), 1) & 0 Then
& && &&&Cells(7, &b&) = Cells(7, &b&) + (sumbypz(Range(&C11:C& & SetRows1), Cells(SetRows2, &j&), -1) * Cells(SetRows2 + 1, &j&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &j&), 1)) * dd(Cells(SetRows2, &j&).Value)
& & Else
& && &&&Cells(7, &b&) = Cells(7, &b&) + sumbypz(Range(&C11:C& & SetRows1), Cells(SetRows2, &j&), -1) * Cells(SetRows2 + 1, &j&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &j&), 1)
& & End If
End If
'可用保证金
Cells(7, &f&) = Cells(7, &a&) + Cells(7, &b&) + Cells(5, &f&) - Cells(5, &d&) - Cells(7, &d&)
If 1.25 - dd(&恒宝股份&) & 0.6 Then
& & Cells(7, &f&) = Cells(7, &f&) - (Cells(7, &e&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &h&), 1) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &i&), 1) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &j&), 1)) * 0.6
Else
& & Cells(7, &f&) = Cells(7, &f&) - (Cells(7, &e&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &h&), 1) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &i&), 1) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &j&), 1)) * (1.25 - dd(&恒宝股份&))
End If
If 1.25 - dd(Cells(SetRows2, &h&).Value) & 0.6 Then
& & Cells(7, &f&) = Cells(7, &f&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &h&), 1) * 0.6
Else
& & Cells(7, &f&) = Cells(7, &f&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &h&), 1) * (1.25 - dd(Cells(SetRows2, &h&).Value))
End If
If 1.25 - dd(Cells(SetRows2, &i&).Value) & 0.6 Then
& & Cells(7, &f&) = Cells(7, &f&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &i&), 1) * 0.6
Else
& & Cells(7, &f&) = Cells(7, &f&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &i&), 1) * (1.25 - dd(Cells(SetRows2, &i&).Value))
End If
If 1.25 - dd(Cells(SetRows2, &j&).Value) & 0.6 Then
& & Cells(7, &f&) = Round(Cells(7, &f&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &j&), 1) * 0.6 - Cells(SetRows2 + 1, &d&) * Cells(3, &c&) * dd(&恒宝股份&), 2)
Else
& & Cells(7, &f&) = Round(Cells(7, &f&) - sumbypz(Range(&A11:A& & SetRows1), Cells(SetRows2, &j&), 1) * (1.25 - dd(Cells(SetRows2, &j&).Value)) - Cells(SetRows2 + 1, &d&) * Cells(3, &c&) * dd(&恒宝股份&), 2)
End If
'融资净利
Cells(7, &g&) = Cells(7, &b&) - Cells(5, &d&) - Cells(7, &d&)
'可融资资金
If Cells(7, &f&) / (1.25 - dd(&恒宝股份&)) &= 0 Then
& & Cells(9, &c&) = Round(Cells(7, &f&) / (1.25 - dd(&恒宝股份&)), 2)
Else
& & Cells(9, &c&) = 0
End If
'可买入恒宝股数
If Cells(9, &c&) = 0 Then
& & Cells(9, &d&) = 0
ElseIf Cells(9, &c&) &= Cells(9, &b&) Then
& & Cells(9, &d&) = Round(Cells(9, &b&) / Cells(3, &c&), 0)
Else
& & Cells(9, &d&) = Round(Cells(9, &d&) / Cells(3, &c&), 0)
End If
'属于我的股数
Cells(9, &e&) = Round(Cells(5, &c&) / Cells(3, &c&), 0)
'属于融资的股数
Cells(9, &f&) = Round(Cells(3, &d&) / Cells(3, &c&), 0)
'总现金
Cells(9, &g&) = Cells(5, &f&) + Cells(SetRows3 + 4, &f&)
'总净资产
Cells(9, &h&) = Cells(5, &c&) + Cells(SetRows3 + 4, &h&)
'最多可买恒宝股数
Cells(9, &i&) = Cells(SetRows3 + 9, &e&) / Cells(3, &c&)
'融资实际利润
Cells(7, &h&) = Round((Cells(9, &e&) + Cells(SetRows3 + 5, &a&) - 259060) * Cells(3, &c&) + Cells(SetRows3 + 9, &g&), 2)
End Sub
复制代码
阅读权限70
在线时间 小时
Sub RZ_DataInfo()
Dim a%, i%, SetRows1%, SetRows2%, H
lab1 = True
Application.ScreenUpdating = False
a = Cells(Rows.Count, &a&).End(3).Row
For i = a To 1 Step -1
& & If Cells(i, &a&) = &成交股数& Then
& && &&&SetRows2 = i
& & ElseIf Cells(i, &a&) = &融资负债及费用合计& Then
& && &&&SetRows1 = i
& && &&&Exit For
& & End If
Next i
'利息负债
If Cells(9, &a&) = &未清算& Then
& & If Cells(SetRows2 - 3, &b&) = && Then
& && &&&Cells(5, &d&) = Cells(SetRows1 + 1, &i&)
& & Else
& && &&&Cells(5, &d&) = Cells(SetRows1 + 1, &i&) - Cells(SetRows2 - 3, &b&)
& & End If
Else
& & Cells(5, &d&) = Cells(SetRows1 + 1, &i&)
End If
'费用负债
For i = 11 To SetRows1 - 1
& & If Cells(i, &c&) = && Then
& && &&&H = H + Cells(i, &c&).Offset(0, -2)
& & End If
Next i
Cells(7, &d&) = H
If Cells(9, &a&) = &未清算& Then
& & If Cells(SetRows1 + 1, &g&) && && Then
& && &&&Cells(7, &d&) = Cells(7, &d&) + Cells(SetRows1 + 1, &g&)
& & End If
& & If Cells(SetRows2 - 3, &d&).Value && && Then
& && &&&Cells(7, &d&) = Cells(7, &d&) - Cells(SetRows2 - 3, &d&).Value
& & End If
End If
'融资负债
H = 0
For i = 11 To SetRows1 - 1
& & If Cells(i, &c&) && && Then
& && &&&H = H + Cells(i, &c&).Offset(0, -2)
& & End If
Next i
Cells(7, &e&) = H
If Cells(9, &a&) = &未清算& Then
& & If Cells(SetRows2 - 3, &a&).Value && && Then
& && &&&Cells(7, &e&) = Cells(7, &e&) - Cells(SetRows2 - 3, &a&).Value
& & End If
End If
'当前负债总额
Cells(3, &d&) = Cells(7, &e&) + Cells(5, &d&) + Cells(7, &d&)
'剩余融资额度
Cells(9, &b&) =
- Cells(7, &e&)
End Sub
Function sumbypz(rng As Range, st As String, off As Integer)
' Application.Volatile True
For Each Rg In rng
If Rg.Offset(0, off).Cells.Comment Is Nothing Then
& & k1 = k1 + Val(Rg)
&&Else
& & If Replace(Rg.Offset(0, off).Cells.Comment.Text, Chr(10), &&) = st Then k = k + Val(Rg)
Next: sumbypz = IIf(st = &&, k1, k)
End Function
复制代码
阅读权限70
在线时间 小时
& & & & & & & &
上面是把25个公式改成的代码，因为相互关联，所以全部执行，导致运行出现短暂停顿，而使用公式则很流畅无停顿
阅读权限70
在线时间 小时
不过直观来看，公式长度要短很多，这么长的代码，一次都执行慢也是应该的，是不是公式多，又不重复，在相互关联的情况下，改成vba代码，全部执行的情况下反而效率低？
阅读权限30
在线时间 小时
分批执行试试，我的代码是运行太久，占用内存会上g，就会慢慢卡，分批是释放内存方便
阅读权限70
在线时间 小时
& & & & & & & &
不过直观来看，公式长度要短很多，这么长的代码，一次都执行慢也是应该的，是不是公式多，又不重复，在相互 ...
技术问题。还是让别人给你写代码吧
最新热点 /1
京东ExcelHome畅销系列图书大联展，满100元-30元现金，莫失良机！
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师excel将同一行的内容分别与第一第二列内容组合形成新的一行，可使用VBA公式_百度知道
excel将同一行的内容分别与第一第二列内容组合形成新的一行，可使用VBA公式
场景：同一个部门有很多人，也有真实姓名一样的，需要将真实姓名与部门序号和部门一一对应，之前试过用转置耗费的时间太多，所以希望用公式或者VBA实现excel将同一行的内容（姓名）分别与第一第二列（部门序号和部门）内容组合形成新的一行（可以参考图中的效...
我有更好的答案
1&+&nbsp,&nbsp.com/zhidao/wh%3D600%2C800/sign=dffbe6d68e025aafd36776cdcbdd875c/18d8bc3eb1338a4d3fd1f40345bca.jpg" esrc="http://g.1).End(xlUp).Row&2).Value&Sheets(1);&&&nbsp.baidu.&nbsp.Value&&&&&&&&&&&&Sheets(2).Cells(Cells(R&Next&Test()&C&&Sheets(1);1&&&&&&&&&&&&Sheets(2).Cells(Cells(Rows.Cells(i;&&nbsp.End(xlUp);&nbsp,&&&3).End(xlUp).Row&+&1,&1);Sheets(1).Cells(i;&&nbsp,&nbsp.Value&=&For&i&For&j&nbsp，请查收有什么问题欢迎继续追问.Rows.Count&=&2&nbsp.hiphotos.baidu.com/zhidao/pic/item/18d8bc3eb1338a4d3fd1f40345Sheets(1);转换完毕&quot.Row&+&&&&&&nbsp.UsedR&&&nbsp.Cells(Cells(Rows.Count,&2);1;&&&&nbsp.Cells(i,&&nbsp,&&End&Sub附件已发送至你的邮箱;=&2&&To&Next&nbsp.Value&=&nbsp.Count).End(xlToLeft).Column&-&nbsp.CTo&MsgBox&nbsp.jpg" target="_blank" title="点击查看大图" class="ikqb_img_alink"><img class="ikqb_img" src="http://g.&&&Sheets(2);=&Sheets(1).Cells(i,&2);&+&1,&3);&nbsp,&j).Value&&nbspSub&nbsp://g;1).Value&nbsp.Count
采纳率：93%
来自团队：
=&Sheet1.hiphotos.baidu.com/zhidao/wh%3D600%2C800/sign=a19d761d57b5c9ea62a60be5e1a18b87d22efce9;C65536&quot.baidu.jpg" esrc="bmxm(i)&=&nbsp.Range(&quot.Cells(i.Row&+&=&Sheet1.com/zhidao/pic/item/fcfaaf51f3deb48f9d13e1c8fc1f3a292df578a9.jpg" target="_blank" title="点击查看大图" class="ikqb_img_alink"><img class="ikqb_img" src="n%bm&nbsp.Row&+&2&To&bmFor&j;1)&nbsp.RowReDim&i%,&j%,&-&2NextSheet2.ActivateFor&);bm)&As&IntegerFor&i&nbsp.End(xlUp).baidu.Row&+&);A65536&quot.hiphotos.baidu.com/zhidao/wh%3D450%2C600/sign=a3d5a01fba003af34defd464001aea6a/d22efce9.Range(&quot,&nbsp.Range(&quot.hiphotos.baidu.com/zhidao/wh%3D450%2C600/sign=0a92d848d1c451daf6a304ef83cd7e50/fcfaaf51f3deb48f9d13e1c8fc1f3a292df578a9;1.Cells(i;Sub严格按格式来sheet1位置如图sheet2位置如图运行结果如下<img class="ikqb_img" src="B65536&=&Sheet1.jpg" esrc="2)Next&bm%://a;To&1;=&2&nbsp.hiphotos.baidu.com/zhidao/wh%3D600%2C800/sign=dc729d0475ba/f3d3572c11dfa9eced0ffd.Column&nbsp
用VBA可以的。需要文件还有你具体的需求！
你可以给下你的邮箱或者其他方式。具体需求就是就是跟截图里面说的那样，把同一行的内容分别与第一第二列内容组合形成新的一行
你的是多少？
ser_xiaochen& 阿里云邮箱
私信，看私信吧
为您推荐：
&#xe675;换一换
回答问题，赢新手礼包&#xe6b9;
个人、企业类
违法有害信息,请在下方选择后提交
色情、暴力
我们会通过消息、邮箱等方式尽快将举报结果通知您。查看: 76|回复: 10
老师能帮我看看代码有什么错误吗，我想要公式和VBA算的值一致
阅读权限20
在线时间 小时
Public Function AC(d1, d2, d3, d4, d5, d6, d7)
&&Dim AC_r(7)
&&AC_r(0) = d1
&&AC_r(1) = d2
&&AC_r(2) = d3
&&AC_r(3) = d4
&&AC_r(4) = d5
&&AC_r(5) = d6
&&AC_r(6) = d7
&&Dim I, j, c As Integer, s, S1 As String
&&For I = 1 To 6
& & For j = 0 To I - 1
& && &S1 = Str(Abs(AC_r(I) - AC_r(j))) + &,& '任意两个数差的正值ABS
& && &If InStr(1, s, S1) = 0 Then
& && && &c = c + 1
& && && &s = s + S1
& && &End If
& & Next j
&&AC = c - (7 - 1)
End Function
Private Sub 计算_Click()
&&Dim s, sj
&&ReDim s(1 To 1, 1 To 4) '重定义数组维数
&&ReDim sj(1 To 4, 1 To 7) '重定义数组维数
&&sj = Range(&C3:I6&)
&&For I = 1 To 4
& & s(1, I) = AC(sj(I, 1), sj(I, 2), sj(I, 3), sj(I, 4), sj(I, 5), sj(I, 6), sj(I, 7))
&&Range(&L3:L6&) = s
19:48 上传
点击文件名下载附件
10.14 KB, 下载次数: 5
阅读权限50
在线时间 小时
Range(&L3:L6&) = s& &改成下面的
Range(&L3:L6&) = Application.Transpose(s)
阅读权限50
在线时间 小时
但是结果好像有一个不对& &自己检查代码吧
公式列和VBA的列的值要求一致& & & & & & & &
公式& & & & VBA& & & &
13& & & & 13& & & &
9& & & & 9& & & &
9& & & & 10& & & &
10& & & & 10& & & &
阅读权限50
在线时间 小时
主要是我们不知道你是怎么算来的结果& && &所以& &呵呵
阅读权限20
在线时间 小时
自定义函数AC（）不知道错在哪里，能指教一下，我知道有的结果和公式相等，有的结要不对，不清楚代码错在哪？
阅读权限20
在线时间 小时
Range(&L3:L6&) = s& &改成下面的
Range(&L3:L6&) = Application.Transpose(s)
不用转置吧，我已经定义了一行四列的数组，还要转置数组吗？
阅读权限20
在线时间 小时
不用转置吧，我已经定义了一行四列的数组，还要转置数组吗？
真的需要转置
阅读权限50
在线时间 小时
呵呵& &定义了一行四列的数组& &可你的结果要求是四行啊
阅读权限50
在线时间 小时
我对函数与公式并不感兴趣& &&&你慢慢研究吧
阅读权限95
在线时间 小时
重新写了一段代码，计算结果跟楼主的代码结果一样，还是跟公式不一样，楼主自己检查吧。
Sub test()
&&Dim r%, i%
&&Dim arr, brr
&&Dim d As Object
&&Set d = CreateObject(&scripting.dictionary&)
&&With Worksheets(&sheet1&)
& & arr = .Range(&c3:i6&)
& & ReDim brr(1 To UBound(arr), 1 To 1)
& & For i = 1 To UBound(arr)
& && &d.RemoveAll
& && &For j = 1 To UBound(arr, 2) - 1
& && &&&For k = j + 1 To UBound(arr, 2)
& && && & x = Abs(arr(i, j) - arr(i, k))
& && && & d(x) = &&
& && &&&Next
& && &Next
& && &brr(i, 1) = d.Count - 6
& & Next
& & .Range(&l3&).Resize(UBound(brr), 1) = brr
&&End With
End Sub
复制代码
最新热点 /1
京东ExcelHome畅销系列图书大联展，满100元-30元现金，莫失良机！
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师用vba如何批量插入图片,公式详解?_百度知道
用vba如何批量插入图片,公式详解?
如上面格式，一个个插入，手工很麻烦。希望高手指导一下，谢谢~！(图片格式是宽3.7CM，高2.5CM)
Insert(&E:&#92，时间: &#39;&#39;
Range(&quot.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 70.5
S坑图&#92;wtl57611Sub Macro3()&#39:I16&).Select
ActiveSheet.Pictures.jpg&).Select
Selection.ShapeR&#39; Macro3 Macro&#39; 宏由 cnhqt 录制;I10.ShapeRange.Width = 105#
Selection.ShapeRange
我有更好的答案
&1&To&12&Step&3&&1&To&16&Step&8&1&To&12&Step&3&&&&&&&&&As&&nbsp.Width&=&nbsp.Select&&&Set&rngPicture&=&End&With&&&&&&&&Set&&&&.Cells(lngRow&+&&&.P&&&&&&nbsp：Option&ExplicitPublic&Sub&1;&&&&&&&&nbsp，也可以设置图片在单元格内水平居中（比单元格大的图片暂不考虑），参考代码如下;&&Integer&&&&&&&&With&ActiveSheet&nbsp.jpg&).ShapeRange&&&&&&&&&&&&&&&&&&&&;+&2)&&&&&&&&&&&&&&&&rngP&&&Dim&lngRow&As&Long&&&&Dim&With&&&&&&&Integer&&&&&&&&With&ActiveSheet&&&&intCol&&&&&&&&&1;&&&&&&Next&&&nbsp您好，根据您的需求，批量插入图片的参考代码如下;&&&&&&&nbsp.Height&&&&Dim&rngPicture&As&Range&For&lngRow&=&&&nbsp,&&&&&nbsp.Insert(&E:\坑图\&&&&&&&1&To&16&Step&8&&&&&;105&&&&&&&&&&&&&&&&End&&&&批量插入图片()&&&&&&intCol&&With&&&For&intCol&=&&nbsp,&intCol&+&2)&&&&&&&&&&&&&&&&rngPicture.Select&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&With&.Pictures.Insert(&E:\坑图\&&&&rngPicture.Value&&&&.jpg&).ShapeRange&&&&&&&&&&&&&&&&&&&&.Left&=&rngPicture.Left&+&(rngPicture.Width&-&.Width)&/&2&&&&&&&&&&&&&&&&&&&&.Top&=&rngPicture.Top&+&(rngPicture.Height&-&.Height)&/&2&&&&&&&&&&&&&&&&End&With&&&&&&&&&&&&Next&&&&&&&&Next&&&&End&With&&&&&&&&Set&rngPicture&=&NothingEnd&Sub：Option&ExplicitPublic&Sub&&&&&&&&&&&&&&&&rngPicture&&&&nbsp.5&&&&&&&&&&&&&&&&&&&&;&&&&For&lngRow&=&&&=&NothingEnd&SubPS：具体使用时请自行修改演示代码中的循环起止行、起止列和步进值。如果图片插入到单元格后出现偏移，请设置 Picture 的 Left 属性和 Top 属性。另外;&intCol&&=&70;&Next&For&intCol&=&&&&&&&&&&&Set&rngPicture&=&.Cells(lngRow&+&&rngPicture.Value&Dim&lngRow&As&Long&&&&Dim&&&&&&批量插入图片水平居中()&Dim&rngPicture&As&Range&&As&nbsp
采纳率：69%
为您推荐：
其他类似问题
插入图片的相关知识
&#xe675;换一换
回答问题，赢新手礼包&#xe6b9;
个人、企业类
违法有害信息,请在下方选择后提交
色情、暴力
我们会通过消息、邮箱等方式尽快将举报结果通知您。

我要回帖

更多关于 VBA 将公式 改为文本 的文章

 

随机推荐