辞書/ループアシスタンスが必要です

Question

私はデータの9つのタブ（いくつかは数千行のデータが含まれています）を持つ場所を完成させるためにいくつかの作業があります。各タブには、（特に）ポリシー番号、クレジット番号、デビット番号が表示されます。

すべてのポリシー番号は、クレジットまたはデビットが等しいタブのどこかに一致します（例：

• タブ1も£100の借方とポリシー番号123を持つことになりますポリシー番号123と£100と
• タブ5の信用を持っています。

私が探しているのは、すべてのタブの各ポリシー番号を調べ、反対の金額がどこにあるかを見て、それぞれのポリシー番号に住所を追加します。

私は確かに私のためのコーディングを作成する誰かを探しているわけではありませんが、私が探しているのはアドバイスです。私はループを使用して見てきましたが、これは処理に非常に時間がかかるかもしれないと感じています。私も辞書を見てきましたが、これには比較的新しいので、あまり自信がありません。

私も探しているものはありますか？もしそうなら、どこからアイデアを始めるか、指し示すべきでしょうか？アドバイスをいただければ幸いです。ありがとう！あなたは

a）すべてのシート、

BをループXMLファイルを作成することができ

Answer 1

）は、負荷法と

Cを経由して、それを開く）（私は与えることができ、簡単なXPathの検索を行います後でいくつかの例）

私は "a）は" これ を遅延バインディング使用A）avoidiステップを行うには、最近の回答（参照excel-vba-xml-parsing-performance） を修正しました最新のMS XMLバージョンバージョン6（msxml6.dll）および への参照b）すべてのXheetsでのデータの取得XMLは、HTMLに匹敵する論理構造のノード上でXPath経由の構造化検索を可能にします。この例のルートノードはデータと呼ばれ、次のノードはシートの名前で命名され、後続のノードはA：Aの各シートの名前を取得します。

XMLファイルは、テキストエディタで開くことができる単純なテキストファイルです。何よりも、VBA XMLDOMメソッドを使用して、アイテム（ノード）を分析または検索することができます。私はあなたの質問に関連する例を与えるが、私に時間を与える。 =>回答「使用例」を参照してください。ここではXMLの利点についても説明します（@Peh）。

追加の注意にも注意してください。 XMLノードは、すべての最初の行のタイトルを使用します。

シート名が

追加注意（重要なヒント）スペースなしである必要はあり

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 

End Subの

注意シート。変更されたプロシージャはUsedRangeを介してタイトル名を取得するので、行Aに空のセルを持たないことが重要です（この例ではA）。

付記 私は（「A」とマークされた）私のプロンプトの答えが誰かによって格下げされた理由を知りません。私それが参考にMatt555 @

Answer 2

使用例

この:-)を主張するために見つけるだろう、あなたがポリシーのシート名を取得するには、次のコードを使用して作成XMLファイルをテストすることができ、「123」と私はあなたのタイトルをA列に置いてコードをテストしました：Aは "方針"と "借方"を含みます

@Peh、そうです、xml domメソッドはvba内であまり頻繁に使用されません。このコネクションでXMLを使用する利点は、XPathによる検索と膨大なファイルに対するパフォーマンスの大幅な柔軟性です。私はユニークな値をフィルタリングするときに配列や辞書にもそれを好む。 HTTPS（あなたがタブ1と[WorksheetFunction.Match方法]の行をループするためにループを使用することができます...データセット全体をループせずにノードリストで見つかった項目の数を返すように

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