是否有任何类似于偏移量的功能可以应用于 VBA 中的集合?

问题描述

作为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 将只保存集合中的最后一个值。如果您只有一个匹配项,但我不确定当有多个匹配项时您想做什么。