0

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

在另一张纸上，我将代码按相应的部门组织，而不是按字母顺序组织。

我正在尝试开发一个宏，以便通过识别代码并粘贴到适当的行中，第一张表中的信息将自动粘贴到第二张表中。

这是到目前为止使用的代码，但它并没有按预期的方式工作：

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

谢谢。

4

1 回答 1

0

应该是.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

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

于 2012-08-09T05:54:58.470 回答