Unable to find how to code: If Cell Value Equals Any of the Values in a Range

问题

I have found the following code after a lot of research and it does a little of what I want it to do except I don't know how to specify the criteria to reference a range of cells instead of just one single criteria.

I am also trying to copy the records and append them to the end of the rows of the matching records in Sheet1. This code only copies the records to Sheet3 so they aren't pasted with their corresponding rows in Sheet1 like I want.

Sub copytosheet()

 Dim sRng As Range, cell As Range
 Dim dRng As Range
 Set sRng = Sheets("Sheet2").Range([A2], [A65536].End(xlUp))
 For Each cell In sRng
 If cell.Value = "80560" Then
 Set dRng = Sheets("Sheet3").[A65536].End(xlUp)(2, 1)
 cell.EntireRow.Copy dRng
 End If
 Next
 End Sub

So, there are 10,000+ records in Sheet2, and 30+ records in Sheet1.
Sheet2 and Sheet1 have an ID number in Column A.
All of the records in Sheet1 will have a matching record in Sheet2.
I want to copy the records from Sheet2 and append them at the end of the record with the same ID in Sheet1.
The code above doesn't solve my problem because it only finds the one record "80560" and copies it to sheet 3.
Thank you so much in advance for any assistance you can offer :)

-Lindsay

回答1:

You'll need to do a bit of programming to get this to work on a set of values and not just '80560'. It will be need to be done in 2 stages.

Make an array that holds your strings, they may be fetched from a location on the spreadsheet. Then a function needs to be made which verifies whether a string exists in the list or not:

Dim DictionaryArray() as String
Redim DictionaryArray(1 to 1000)
' Fill it with the stuff you need to check against
' e.g. DictionaryArray(1) = '80536', etc.
' Do note this is HIGHLY INEFFICIENT, you would need to use a nice binary search algo to make it fast, after sorting it internally

' Now build a function to check if a given string is in this dictionary
Function CheckIfFound(StringToCheck as string, DictionaryArray() as string) as Boolean
    'Implement some search function here
End Function

And finally in your code that you posted, replace the verification step with

if CheckIfFound(cell.Value, DictionaryArray) = True then
' ---- Implement rest of your code

Edit: With regard to the problem as described below, something like this can be done:

Sub CopyFrom2TO1()
    Dim Source as Range, Destination as Range
    Dim i as long, j as long

    Set Source = Worksheets("Sheet1").Range("A1")
    Set Dest = Worksheets("Sheet2").Range("A2")

    for i = 1 to 100

        for j = 1 to 100
            if Dest.Cells(j,1) = Source.Cells(i,1) then
                    Source.Range("A" & j).Range("A1:Z1").Copy ' A1:Z1 relative to A5 for e.g.
                    Dest.Range("A"&i).Paste
                    Exit For
            end if
        next j
    next i
End Sub

Again, this is highly inefficient, with O(n^2) complexity, but will work.

来源：https://stackoverflow.com/questions/24518157/unable-to-find-how-to-code-if-cell-value-equals-any-of-the-values-in-a-range

标签

vba

copy

range

criteria