Question

Here explaining Imagen 有人请帮助我以下。我有两张excel文件。第1页，其中包含一个完整的键（id）值列表。第二个是工作表2，其中包含从其他文档中提取的值列表，这些值与这些键值部分匹配，其中大部分都是重复的，并且它们在相邻列中有信息。问题。我想开发一个代码，它将找到Sheet 2上的每个日志及其对应的Sheet 1（完整列表），对于每个真实的复制日志（有时很多），其中包含相关列中的链接数据。我的代码有效，但是当我有超过1000个日志时它太慢了。我试图找到一种选择和/或复制重复范围的方法，而不是一行一行。请你帮个忙吗？非常感谢！

以下是我的代码：

Sub Mod2()    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim sh1, sh2 As Worksheet
    Dim rng As Range, c As Range, cfind As Range, rng1 As Range

    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    Worksheets("Insert").Activate

    Set rng = sh2.Range(sh2.Range("E10"), sh2.Range("E10").End(xlDown))
    Set rng1 = sh1.Range(sh1.Range("E15"), sh1.Range("E3000"))

    With sh1
    On Error Resume Next

        sh1.Activate
        'rng1.Select

        For Each c In rng
            Set cfind = rng1.Cells.Find(what:=c.Value, LookAt:=xlWhole, after:=Range("E15"), SearchDirection:=xlPrevious)            

            If Not cfind Is Nothing Then
                cfind.Offset(1, 0).Insert shift:=xlDown
                c.Offset(0, 1).Copy

                With cfind.Offset(0, 1)
                    .Insert shift:=xlDown
                    .PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
                End With

                c.Offset(0, 10).Copy

                With cfind.Offset(0, 10)
                    .Insert shift:=xlDown
                    .PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
                End With            
            End If
        Next c            
    End With
End Sub

Answer 1

我会使用数组而不是范围，因为它们更快.a 下面的代码忽略了行的插入。它只是用ID中的信息更新相应的副本。眨眼之间:)。

{{1}}

另请注意，这将替换所有重复的10列（第3~9列中为空值）。这可以通过创建多个数组（只需要更新的列）来处理，只写那些，所以也许可以写3个。

一次按单元格值查找和复制范围

1 个答案: