需要詞典/循環協助

我有一些工作要完成，我有9個數據標籤（其中一些包含數千行數據）。每個標籤包含（除其他之外）保單號，信用卡和/或借方號碼。需要詞典/循環協助

每個策略數量將含有相同的信用卡或借記卡，例如標籤有一個匹配的地方

標籤1將有保單號123和100£和
標籤5信貸也將有保單號123£100借方。

什麼我希望做的是，通過看每個保單號碼每個選項卡上，找到相對量位於增加位置的地址到每個保單號碼在哪裏。

我肯定不會找任何人創建的編碼爲我，但我所尋找的是忠告。我已經看過使用循環，但覺得這可能需要很長時間來處理。我也看過字典，但對這些比較新，所以我不太自信。

我正在尋找甚至可能嗎？如果有的話，有什麼想法從哪裏開始或指點？任何意見是極大的讚賞。謝謝！

2017-06-20 Matt555

你可以使用一個循環，通過標籤1又WorksheetFunction.Match方法]（HTTPS行循環： //msdn.microsoft.com/en-us/library/office/ff835873.aspx）或[Range.Find方法]（https://msdn.microsoft.com/en-us/library/office/ff839746.aspx）查看當前行的其他選項卡中是否存在匹配項。同樣按保單號碼排序可以縮短循環。 –

爲什麼不使用vba'Find'功能。您可以搜索所有匹配的保單號碼（如果對保單號碼有多個借方/貸方等） – Tom

當您說標籤時，是否指列？在這種情況下數據看起來像什麼（舉例）？ – Vegard

你可以

一）創建一個XML文件通過所有表循環，

二）通過加載方法打開它，

C）執行簡單的XPath搜索（我可以給後來一些例子）

我修改了一個最近的答案（參見excel-vba-xml-parsing-performance）做一步「一）」使用後期綁定從而一）avoidi參考最新的MS XML Version Version 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」）被某人降級。我會覺得有幫助的爭論這個:-)

來源

2017-06-20 09:50:54

只是爲了我個人的興趣：我以前從未見過這樣的方法（用於查找不同工作表中的匹配數據）。如果你可以在你的答案中解釋，這將是很好的。*爲什麼這種使用XML的方法比使用* match *或* find *更明顯的方法是一個優點（或者至少爲什麼選擇它），因爲它看起來非常麻煩，對我來說不是很透明。 –

@Peh，你說得對，xml dom方法在vba中不常用。在這個連接中使用XML的優點是在通過XPath進行搜索時具有很大的靈活性，以及在大文件上的性能。在過濾唯一值時，我甚至喜歡數組或字典。可以在節點列表中返回找到的項目編號，而無需循環遍歷整個數據集... –

用法示例

@ Matt555，您可以測試創建XML文件用下面的代碼來獲得政策「123」的工作表名稱和我測試了代碼，假設您的行在A行：A包含「政策」和「借記卡」

@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

來源

2017-06-20 12:40:22

需要詞典/循環協助

回答

相關問題