0

在此处输入图像描述

我附上了一张图片，显示了我的数据和我想要实现的目标。

我的代码不能正常工作。它复制 14 和 bb1 的数据，然后卡在循环中。请帮我纠正。

为什么我要使用 find 方法是，在前的 H 行中，我将在 1000 行中匹配大约 20 到 30 个 id ..所以循环一整行需要很长时间。

任何想法如何更正和优化代码。谢谢

Sub Findandcopy()

    Dim shtOld As Worksheet, shtNew As Worksheet
    Dim oldRow As Integer
    Dim newRow As Integer
    Dim i As Integer, id, f As Range
    Dim g As Range
    Dim currow As Long

    Set shtOld = ThisWorkbook.Sheets("Sheet1")
    Set shtNew = ThisWorkbook.Sheets("Sheet2")


With shtOld.Range("H1:H30")
    Set c = .find("*")

    If Not c Is Nothing Then
        firstAddress = c.Address

        Do


            Set f = shtNew.Range("G2:G40").find(c)

            If Not f Is Nothing Then

                    currow = f.Cells.Row
                    shtNew.Activate
                    Set g = shtNew.Range("G" & currow).Resize(4, 2)
                    g.Copy
                    shtOld.Activate
                    shtOld.Range("I" & c.Row).Select
                    ActiveSheet.Paste

            End If



            Set c = .FindNext("*")

            Loop While Not c Is Nothing And c.Address <> firstAddress

    End If
End With


End Sub
4

1 回答 1

0

这就是我想出的......我没有使用查找和替换，只是简单地遍历两个源表中的值。我已经评论了代码，所以应该很容易看到它在做什么。

我已经对其进行了测试，它适用于我从您提供的丝网印刷中复制的一些数据。

Sub Findandcopy()

Dim sourceSht1 As Worksheet _
, sourceSht2 As Worksheet _
, destinationSht As Worksheet

Dim sourceValue As String
Dim endRow As Long

Dim counter As Integer

Set sourceSht1 = Sheet1
Set sourceSht2 = Sheet2
Set destinationSht = Sheet3

On Error GoTo Err

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


'get the end row of sourceSht2 (column H)
endRow = sourceSht2.Range("H" & sourceSht2.UsedRange.Count + 1).End(xlUp).Row


    'loop backwards as the sourceSht1 value that we want to get is after the beginning
    For i = endRow To 1 Step -1

    counter = counter + 1

    'get value from sourceSht 1
    If sourceSht1.Cells(i, 8).Value <> "" Then _
    sourceval = sourceSht1.Cells(i, 8).Value

    'we always copy the number from sourceSht2
    destinationSht.Cells(i, 10).Value = sourceSht2.Cells(i, 8).Value

            'if the counter is 4 then we've reached the top of the list
            If counter = 4 Then

            'value in column G is always at the top of the section (sourceSht2)
            destinationSht.Cells(i, 9).Value = sourceSht2.Cells(i, 8).Value

            'copy the value we stored from sourceSht1 (set number format to text)
            destinationSht.Cells(i, 8).NumberFormat = "@"
            destinationSht.Cells(i, 8).Value = sourceval


            'reset sourceval in case next section doesn't have any value in column H
            sourceval = ""

            'reset counter
            counter = 0

            End If
    Next i


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic


Exit Sub

Err:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub
于 2013-11-03T20:53:37.300 回答