需要字典/循环帮助

Question

我有一些工作要完成，我有 9 个数据选项卡（其中一些包含数千行数据）。每个选项卡都包含（除其他外）保单编号、贷记号和/或借记号。

每个保单编号都会在包含相同贷方或借方的选项卡中的某处匹配，例如

• 标签 1 的保单编号为 123，信用额度为 100 英镑，
• 标签 5 的保单编号为 123，借方为 100 英镑。

我要做的是，查看每个选项卡上的每个保单号码，并找到相反金额的位置，将位置地址添加到每个保单号码。

我当然不是在寻找任何人来为我编写代码，但我正在寻找的是建议。我看过使用循环，但觉得这可能需要很长时间来处理。我也看过字典，但对这些比较陌生，所以不太自信。

我正在寻找的东西是否可能？如果是这样，有什么想法从哪里开始或指针？任何意见是极大的赞赏。谢谢！

Answer 1

使用示例

@Matt555，您可以使用以下代码测试创建的 XML 文件，以获取政策“123”和借方为 100 的工作表名称。我假设您在 A 行中的标题测试了代码： A 包含“policy”和“debit”

@Peh，你是对的，xml dom 方法在 vba 中不经常使用。在此连接中使用 XML 的优势在于通过 XPath 进行搜索时具有极大的灵活性以及对大文件的性能。在过滤唯一值时，我什至更喜欢数组或字典。可以在节点列表中返回找到的项目编号，而无需遍历整个数据集...

Option Explicit
Sub testPolicy()
   Dim policy
   Dim debit As Double

   policy = "123"
   debit = "100"

   MsgBox "Policy " & policy & " found in " & vbNewLine & _
          findSheetName(policy, debit), vbInformation, "Policy " & policy & " in Tabs"
   ' You can easily split this to an array and analyze the results
End Sub


Function findSheetName(ByVal policy, Optional ByVal debit) As String
' Purpose: Finds Sheet Names where policy AND/OR debit is found
' Note:    Assuming your titles in row A:A contain "policy" and "debit"
'          You can declare xDoc also after Option Explicit to make it public
Dim xDoc    As Object
Dim xNd     As Object ' MSXML.IXMDOMNode
Dim xNdList As Object ' MSXML.IXMLDOMNodeList
Dim s     As String
' XPath expression
Dim xPth  As String

If IsMissing(debit) Then
    xPth = "//row[policy=""" & policy & """]"
Else
    xPth = "//row[policy=""" & policy & """][debit=""" & debit & """]"
End If

' XML to memory
Set xDoc = CreateObject("MSXML2.Domdocument.6.0")
' allow XPath
xDoc.setProperty "SelectionLanguage", "XPath"
xDoc.validateOnParse = False
' ========
' LOAD XML
' ========
xDoc.Load ThisWorkbook.Path & "\" & "output.xml"

' Loop thru NodeList
Set xNdList = xDoc.DocumentElement.SelectNodes(xPth)
Debug.Print xPth, xNdList.Length
For Each xNd In xNdList
    s = s & xNd.ParentNode.NodeName & "|"
Next xNd

Set xDoc = Nothing

findSheetName = s
End Function

Answer 2

你可以

a) 创建一个 XML 文件 循环遍历所有工作表，

b) 通过 load 方法打开它并

c) 执行一个简单的 XPath 搜索（稍后我会给出一些示例）

我修改了最近的答案（参见excel-vba-xml-parsing-performance） 因此，使用后期绑定执行步骤“a)” a) 避免引用最新的 MS XML 版本 6 (msxml6.dll) 和 b) 获取所有 xheets 的数据。 XML 允许您通过 XPath 在与 HTML 相当的逻辑结构中的节点上进行结构化搜索。本例中的根节点称为数据，以下节点以工作表名称命名，后续节点获取每个工作表的 A:A 行中的名称。

XML 文件是一个简单的文本文件，您可以使用文本编辑器打开它。最重要的是，您可以使用 VBA XMLDOM 方法来分析或搜索项目（节点）。我将为您提供与您的问题相关的示例，但请给我一些时间。 => 请参阅答案“使用示例”，其中我也解释了 XML 的一些优点 (@Peh)。

请注意添加的注释。

Option Explicit

Sub xmlExportSheets()
' Zweck: XML Export over all sheets in workbook
' cf. Site:  [excel-vba-xml-parsing-performance][1][https://stackoverflow.com/questions/40986395/excel-vba-xml-parsing-performance/40987237#40987237][1]
' Note:  pretty printed raw output with line breaks and indentation using an embedded XSLT stylesheet
On Error GoTo ErrHandle
' A. Declarations
' 1  DECLARE XML DOC OBJECT '
' a) Early Binding: VBA REFERENCE MSXML, v6.0 necessary'
'    Dim doc      As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60, newDoc As New MSXML2.DOMDocument60
'    Dim root     As IXMLDOMElement, dataNode As IXMLDOMElement, datesNode As IXMLDOMElement, namesNode As IXMLDOMElement
' b) Late Binding XML Files:
  Dim doc       As Object
  Dim xslDoc    As Object
  Dim newDoc    As Object
' c) Late Binding XML Nodes:
  Dim root      As Object
  Dim sh        As Object   ' xml node containing Sheet Name
  Dim dataNode  As Object
  Dim datesNode As Object
  Dim namesnode As Object

' 2   DECLARE   other variables
  Dim i         As Long
  Dim j         As Long
  Dim tmpValue  As Variant
  Dim tit       As String
  Dim ws        As Worksheet

' B.  XML Docs to Memory
  Set doc = CreateObject("MSXML2.Domdocument.6.0")
  Set xslDoc = CreateObject("MSXML2.Domdocument.6.0")
  Set newDoc = CreateObject("MSXML2.Domdocument.6.0")

' C.  Set DocumentElement (= root node)'
  Set root = doc.createElement("data")
' D.  Create Root Node
  doc.appendChild root


' ===========================
' ITERATE THROUGH Sheets
' ===========================
For Each ws In ThisWorkbook.Sheets
    Set sh = doc.createElement(ws.Name)     '
    root.appendChild sh

  ' ===========================
  ' ITERATE THROUGH ROWS                              ' A2:NNn
  ' ===========================
  For i = 2 To ws.UsedRange.Rows.Count                ' Sheets(1)

    ' DATA ROW NODE '
    Set dataNode = doc.createElement("row")     '
    sh.appendChild dataNode

    ' TABLES NODE (orig.: DATES NODE) '
    Set datesNode = doc.createElement(ws.Cells(1, 1))     ' Dates
    datesNode.Text = ws.Range("A" & i)
    dataNode.appendChild datesNode

    ' NAMES NODE '
    For j = 1 To ws.UsedRange.Columns.Count - 1 ' = 12
        tit = ws.Cells(1, j + 1)
        tmpValue = ws.Cells(i, j + 1)
            Set namesnode = doc.createElement(tit)
            namesnode.Text = tmpValue
            dataNode.appendChild namesnode
    Next j

  Next i

Next ws

' =============================
' PRETTY PRINT RAW OUTPUT (XSL)
' =============================
  xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _
        & "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _
        & "                xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _
        & "<xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _
        & "<xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _
        & "            encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _
        & " <xsl:template match=" & Chr(34) & "node() | @*" & Chr(34) & ">" _
        & "  <xsl:copy>" _
        & "   <xsl:apply-templates select=" & Chr(34) & "node() | @*" & Chr(34) & " />" _
        & "  </xsl:copy>" _
        & " </xsl:template>" _
        & "</xsl:stylesheet>"
' XSLT (Transformation)
  xslDoc.async = False
  doc.transformNodeToObject xslDoc, newDoc
' =================
' Save the XML File
' =================
  newDoc.Save ThisWorkbook.Path & "\Output.xml"

  MsgBox "Successfully exported Excel data to " & ThisWorkbook.Path & "\Output.XML!", vbInformation
' Regular End of procedure
  Exit Sub

 ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical
  Exit Sub

结束子

注意

工作表名称不能有空格

添加注释（重要提示）： XML 节点在每张纸的第一行使用标题。由于修改后的过程通过 UsedRange 获取标题名称，因此对于此示例，在 A:A 行中不要有任何空单元格很重要。

补充说明 我不知道我的快速回答（标记为“a”）被某人降级的原因。我觉得争论这个很有帮助:-)