无法找到如何编码:如果单元格值等于范围中的任何值

时间:2014-07-01 19:47:55

标签: vba copy range criteria

经过大量研究后我发现了以下代码,除了我不知道如何指定引用一系列单元格而不仅仅是一个单一条件的标准外,它还做了一些我想做的事情。

我也在尝试复制记录并将它们附加到Sheet1中匹配记录行的末尾。此代码仅将记录复制到Sheet3,因此它们不会像我想要的那样粘贴在Sheet1中的相应行。

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

因此,Sheet2中有10,000多条记录,Sheet1中有30多条记录。
Sheet2和Sheet1在A列中有一个ID号 Sheet1中的所有记录都将在Sheet2中具有匹配的记录 我想复制Sheet2中的记录,并将它们附加到记录的末尾,并在Sheet1中使用相同的ID 上面的代码没有解决我的问题,因为它只找到一个记录“80560”并将其复制到表3 非常感谢您提供的任何帮助:)

-Lindsay

1 个答案:

答案 0 :(得分:0)

您需要进行一些编程才能使其在一组值上运行,而不仅仅是' 80560'这将需要分两个阶段完成。

创建一个包含字符串的数组,可以从电子表格中的某个位置获取它们。然后需要一个函数来验证列表中是否存在字符串:

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

最后在您发布的代码中,用

替换验证步骤
if CheckIfFound(cell.Value, DictionaryArray) = True then
' ---- Implement rest of your code

编辑: 关于如下所述的问题,可以这样做:

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

同样,这是非常低效的,具有O(n ^ 2)复杂度,但是可以工作。