列出符合條件的所有值

目前我有一個宏，它只清除當前作業表中“D3：D1000”中的值，然后查看一個名為“SCHEDULE CALCULATIONS”的作業表，通過“O”列搜索并查找匹配（該值在“A1”中定義當前作業表的），當找到匹配項時，它會復制同一行的“A”列中的值并將其粘貼到從“D3”開始的當前作業表中，并繼續作業，直到找到所有匹配項并移動到下一個作業表并執行相同的操作，直到完成除了已定義為不做的作業表之外的所有作業表。

Sub FILL_CHASSIS_REF()

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> "GALVANISED" And ws.Name <> "ALUMINUM" And ws.Name <> "LOTUS" And ws.Name <> "TEMPLATE" And ws.Name <> "SCHEDULE CALCULATIONS" And ws.Name <> "TRUSS" And ws.Name <> "DASHBOARD CALCULATIONS" And ws.Name <> "GALVANISING CALCULATIONS" Then
With ws.Range("D3:D1000")
    .Formula2R1C1 = _
        "=IF(ROWS(R2C25:R[-1]C[21])<=COUNTIF('SCHEDULE CALCULATIONS'!R2C15:R1000C15,R1C1),INDEX('SCHEDULE CALCULATIONS'!R2C1:R1000C1,AGGREGATE(15,3,('SCHEDULE CALCULATIONS'!R2C15:R1000C15=R1C1)/('SCHEDULE CALCULATIONS'!R2C15:R1000C15=R1C1)*(ROW('SCHEDULE CALCULATIONS'!R2C15:R1000C15)-{1}),ROWS(R2C25:R[-1]C[21]))),"""")"
    .Value = .Value
   End With
   
End If

Next ws

End Sub

雖然這項作業需要時間，因為目前有 26 張紙要通過。我知道這段代碼效率太低，而且我知道的東西還不夠好。任何幫助將不勝感激。

uj5u.com熱心網友回復：

在對同一組值進行數千次搜索時，將資料加載到Dictionary會更快。使用預加載的字典，您只需在每張紙上搜索一次字典，然后檢索所有值。

在回圈之前，添加一個回圈，該回圈遍歷作業SCHEDULE CALCULATIONS表并將每個 Column O 值作為鍵添加到字典中，字典項將是 A 列范圍。如果有多行具有相同的鍵（O 列），那么我們可以將范圍相加，因此該專案本質上將成為 A 列單元格的集合（每個 O 列值一個集合）。

一旦你有了這個字典，每個作業表都可以通過執行從字典中找到所有匹配的值Dictionary(MyValue)。但是如果字典中沒有，那會出錯MyValue，所以首先檢查If Dictionary.Exists(MyValue) Then. 從值中收集范圍后，將它們輸出到 D 列是一項簡單的任務。

Sub FILL_CHASSIS_REF()
    Dim Cell As Range

    Dim SchCals As Worksheet
    Set SchCals = Worksheets("SCHEDULE CALCULATIONS")
    
    'Creating a Dictionary
    Dim ColumnValues As Object
    Set ColumnValues = CreateObject("Scripting.Dictionary")
    
    'Looping through O2:O1000 of SCHEDULE CALCULATIONS
    
    For Each Cell In SchCals.Range("O2:O1000").Cells
        
        'If the value isnt empty
        If Not IsEmpty(Cell.Value) Then
            'if the dictionary doesn't already have this, add it
            If Not ColumnValues.Exists(CStr(Cell.Value)) Then
                'Dictionary Key is the Column O value and the Item is the Column A range
                ColumnValues.Add CStr(Cell.Value), Cell.EntireRow.Cells(1, 1)
            Else
            'if the dictionary already has this value, add the ranges together
                Set ColumnValues(CStr(Cell.Value)) = Union(ColumnValues(CStr(Cell.Value)), Cell.EntireRow.Cells(1, 1))
            End If
        End If
    Next
    
    'For each worksheet
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        'Excluding these worksheets
        If ws.Name <> "GALVANISED" And ws.Name <> "ALUMINUM" And ws.Name <> "LOTUS" And ws.Name <> "TEMPLATE" And ws.Name <> "SCHEDULE CALCULATIONS" And ws.Name <> "TRUSS" And ws.Name <> "DASHBOARD CALCULATIONS" And ws.Name <> "GALVANISING CALCULATIONS" Then
        
            'Saving the value from Cell A1
            Dim A1 As String: A1 = CStr(ws.Cells(1, 1).Value)
            
            'If the dictionary has this value
            If ColumnValues.Exists(A1) Then
                Dim i As Long
                i = 3 'Index for Column D
                
                'For each range saved in the dictionary for this value
                For Each Cell In ColumnValues(A1).Cells
                    ws.Cells(i, 4).Value = Cell.Value 'Put each value into Column D, starting from 3
                    i = i   1
                Next
            End If
        End If
    
    Next ws

End Sub

標籤：

上一篇：如何知道/顯示python串列中的索引？[復制]

下一篇：使用python將前綴計數寫入txt檔案