问题描述
作为VBA的基础用户,想知道有没有类似offset函数的东西可以应用到集合的元素上。它是否存在或是否需要创建为用户定义的函数?我想从与接受的答案(再次感谢您,蒂姆)中的代码类似的内容开始,以解决以下问题 Updating an .xml document according to a .csv file。 为简单起见,假设我必须在 .csv 文件中执行查找,我将使用下面的函数,它将是一个集合对象。
Sub editxml()
Dim Obj As MSXML2.DOMDocument
Dim xmlpath As String
Dim Node As IXMLDOMNodeList
Dim Nm As IXMLDOMNode
Dim thing As Object,q As Object
Dim wb As Workbook,ws As Worksheet
Dim matches As Collection
Set Obj = New DOMDocument
Obj.async = False
Obj.validateOnParse = False
xmlpath = "C:\Users\xxx\Desktop\ppp.xml"
Obj.SetProperty "SelectionNamespaces","xmlns:ns0='http://update.DocumentTypes.Schema.ppp.Xml'"
If Obj.Load(xmlpath) = True Then
MsgBox "File XML uploaded"
Else
MsgBox "File XML not uploaded"
Exit Sub
End If
'open the CSV file
Set wb = Workbooks.Open("C:\Users\xxx\Desktop\mycopy.csv")
Set ws = wb.Worksheets(1)
Set Node = Obj.DocumentElement.SelectNodes("AA/BB/CC/DD")
For Each Nm In Node
Set thing = Nm.SelectSingleNode("thing")
Set q = Nm.SelectSingleNode("qt")
'moved the Find logic to a standalone function
Set matches = FindAll(ws.Range("AR:AR"),thing.Text)
'did we get any matches in the range?
If matches.Count > 0 Then
'This section of the code should perform some computations according to the value of a particular cell in a different column,so basically it should offset the element of the collection.
q.Text = "do somewhat else"
End If
Next
Obj.Save xmlpath
End Sub
'find all matching cells in a range and return them in a Collection
Public Function FindAll(rng As Range,val As String) As Collection
Dim rv As New Collection,f As Range,addr As String
Set f = rng.Find(what:=val,after:=rng.Cells(rng.Cells.Count),_
LookIn:=xlValues,LookAt:=xlWhole,SearchOrder:=xlByRows,_
SearchDirection:=xlNext,MatchCase:=False)
If Not f Is nothing Then addr = f.Address() 'store first cell found
Do Until f Is nothing
rv.Add f
Set f = rng.FindNext(after:=f)
If f.Address() = addr Then Exit Do 'exit if we've looped back to first cell
Loop
Set FindAll = rv
End Function
我知道偏移函数可以应用于 VBA 中的范围对象。如果我必须使用范围,我会在代码的缺失部分做类似的事情,但这显然不起作用。我想将对象匹配作为一个集合,因为它更适合我的目的。
If matches.Count > 0 Then
'This section of the code should perform some computations according to the value of a particular cell in a different column,so basically it should offset the element of the collection.
q.Text = matches.offset(0,-3).value*matches.offset(0,-6)
End If
Next
更新:我想在我的 .csv 文件的单元格中的值之间执行一些计算。对于集合中的每个元素,即地址,假设匹配的第一个元素是 AR2,我必须执行类似 D2*S2 的操作。基本上,我必须从函数的结果开始,并按列“移动”,保持在同一行。这就是偏移量的含义。
解决方法
由于集合是范围的集合,因此您必须遍历它们:
If matches.Count > 0 Then
Dim match As Range
For Each match in matches
q.Text = match.Offset(0,-3).Value * match.Offset(0,-6).Value
Next match
End If
注意:q.Text
将只保存集合中的最后一个值。如果您只有一个匹配项,但我不确定当有多个匹配项时您想做什么。