Question

我每天都有来自外部来源的数据。在一张纸上，我有一个股票代码符号列表（按字母顺序排序），相应的数据在该行继续。

在另一张表格中，我有相应部门组织的自动收报机，而不是按字母顺序排列。

我正在尝试开发一个宏，以便第一张工作表中的信息会自动粘贴到第二张工作表中，方法是识别自动收报机并粘贴到相应的行中。

这是目前使用的代码，但它没有达到预期的效果：

Dim LSymbol As String
    Dim LRow As Integer
    Dim LFound As Boolean

    On Error GoTo Err_Execute

    'Retrieve symbol value to search for
    LSymbol = Sheets("Portfolio Update").Range("B4").Value

    Sheets("Test").Select

    'Start at row 2
    LRow = 2
    LFound = False

    While LFound = False

        'Encountered blank cell in column B, terminate search
        If Len(Cells(2, LRow)) = 0 Then
            MsgBox "No matching symbol was found."
            Exit Sub

        'Found match in column b
        ElseIf Cells(2, LRow) = LSymbol Then

            'Select values to copy from "Portfolio Update" sheet
            Sheets("Portfolio Update").Select
            Range("B5:V5").Select
            Selection.Copy

            'Paste onto "Test" sheet
            Sheets("Test").Select
            Cells(3, LRow).Select
            Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=False

            LFound = True
            MsgBox "The data has been successfully copied."

        'Continue searching
        Else
            LRow = LRow + 1
        End If

    Wend

    On Error GoTo 0

    Exit Sub

Err_Execute:
    MsgBox "An error occurred."

End Sub

感谢。

Answer 1

应该是.Cells(row,col) not。Cells（col，row）`

但是，您可以使用Find（） -

来避免循环

Sub Tester()

    Dim LSymbol As String

    Dim shtPU As Worksheet
    Dim shtTest As Worksheet
    Dim f As Range
    Dim c As Range

    Set shtPU = Sheets("Portfolio Update")
    Set shtTest = Sheets("Test")

    On Error GoTo Err_Execute

    For Each c In shtPU.Range("B4:B50").Cells

       LSymbol = c.Value 'Retrieve symbol value to search for

       If Len(LSymbol) > 0 Then
            Set f = shtTest.Columns(2).Find(LSymbol, , xlValues, xlWhole)
            If Not f Is Nothing Then
                'was found
                With c.Offset(0, 1).Resize(1, 21)
                    f.Offset(0, 1).Resize(1, .Columns.Count) = .Value
                End With
                c.Interior.Color = vbGreen
                'MsgBox "The data has been successfully copied."
            Else
                'not found
                c.Interior.Color = vbRed
                'MsgBox "No matching symbol was found."
            End If
       End If

    Next c

    Exit Sub

Err_Execute:
    MsgBox "An error occurred:" & Err.Description

End Sub

编辑 - 在循环遍历符号列表中添加

记录宏（Excel 2003）以逐行有条件地复制

1 个答案: