简体   繁体   中英

Excel VBA Find All

As usual, I've wasted hours working on a problem before finally giving in and asking for help, so any help would be greatly appreciated!

I'm running a while loop on Sheet Test1 of my data in order to copy data to a specific row on Sheet Test2 where parameters match, but the way I'm currently doing this is by also looping through every row of Sheet 2 - both sheets of data are over 50,000 lines long, so although my method works perfectly for my 10 row tests it is taking several hours to work for the full data. I was wondering if someone could simplify my code, ideally so that it could search for matching rows rather than comparing each one?

I have tried using Find but I couldn't get it to work with multiple parameters.

This is my current code, I've omitted the part where I set the parameter settings to save space but they are present in my Worksheet:

While row1 <= lastRow1
    Param1 = Sheets("Test1").Cells.Range("A" & row1).Value
    Param2 = Sheets("Test1").Cells.Range("B" & row1).Value
    Param3 = Sheets("Test1").Cells.Range("D" & row1).Value
    Param4 = Sheets("Test1").Cells.Range("E" & row1).Value
    Param5 = Sheets("Test1").Cells.Range("F" & row1).Value
    Cell_to_copy = Sheets("Test1").Cells.Range("G" & row1).Value
*****THIS IS THE BIT I WANT TO OPTIMISE************
        For row2 = 2 To lastRow2
            KParam1 = Sheets("Test2").Cells.Range("A" & row2).Value
            KParam2 = Sheets("Test2").Cells.Range("B" & row2).Value
            KParam3 = Sheets("Test2").Cells.Range("I" & row2).Value
            KParam5 = Sheets("Test2").Cells.Range("G" & row2).Value
                If (InStr(1, KParam1, Param1) > 0) _
                And ((InStr(1, KParam2, Param2) > 0) Or (InStr(1, Param2, KParam2) > 0)) _
                And ((InStr(1, KParam3, Param3) > 0) Or (InStr(1, KParam3, Param4) > 0)) _
                And (InStr(1, KParam5, Param5) > 0) _
                Then
                    Sheets("Test2").Cells.Range("L" & row2).Value = Cell_to_copy
                End If
        Next row2
****************************************************
        row1 = row1 + 1
Wend

I'd like to change the middle section to instead perform a search function to locate rows that match the If query, and then copy the Cell_to_copy to Cell L on that row.

Is this possible? I can concatenate the searchable values from Test2 into a single cell if it's absolutely necessary, but I'd rather not if it can be avoided as it will match some false positives.

Thanks in advance,

Joe

ok, so the rule seems to be, if

Test1.column A is found inside Test2.column A
Test1.column B is found inside Test2.column B
Test1.column D is found inside Test2.column I
Test1.column E is found inside Test2.column I
Test1.column F is found inside Test2.column G

then copy Test1.column G to Test2.Column L

is that right?

Why can't you do that using a formula on Sheet2?

maybe: Test2.Column L formula = =IF(FIND(A:A,Sheet1!A:A)>0,Sheet1!G:G)

that formula needs an OR with the other conditions to make it check the other columns - will try after lunch!

if not, then ok, here I think we need to consider using ADO and treating the worksheet as a db table.

If you show what your source data looks like, and the result you need, I can try and write a sample for you, but by far the best option is for you to learn to fish using the below links.

see here for this: MSDN KB: How To Use ADO with Excel Data from Visual Basic or VBA

and also read: Treat Excel As a Relational Data Source on the Excel User MVP website

and also read: Office Space: Using ADO to Query an Excel Spreadsheet

basically the task is to read the filtered data that you need into an ADO Recordset, then use CopyFromRecordset method to dump the results into Sheet2 in one step

So you have some reading to do, let us know if you need an example or more help

Philip

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM