查找写入单元格的值,然后将单元格旁边的单元格复制到不同的工作表中,以查找未定义的范围

时间:2018-02-01 14:19:20

标签: excel vba excel-vba

在VBA中编写宏以在数据表中查找字符串(在评分表上输入)的最佳方法是什么,然后将值复制到找到的字符串的左侧(在数据表上)并粘贴它在评分表的左边? 我对VBA很新,这是我到目前为止所做的,但是当我运行代码时Excel崩溃了。

Dim x As Integer
Application.ScreenUpdating = False
' Set numrows = number of rows of data.
NumRows = Range("C6", Range("C6").End(xlDown)).Rows.Count
' Select cell a1.
Range("C6").Select
' Establish "For" loop to loop "numrows" number of times.   

   x = 1
   Sheets("Scoring").Select
   Do While x <= NumRows

      'Dim ws As Worksheet
      'Set ws = Worksheets("Data")

      Dim y As String
      y = Cells(5 + x, 3).Value

      Cells.Find(What:=y, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
          :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
          False, SearchFormat:=False).Activate

      Sheets("Data").Range

      Cells.FindNext(After:=ActiveCell).Activate

      Selection.Resize(, Selection.Columns.Count + 0).Offset(, -1).Select
      Selection.Copy
      Application.CutCopyMode = False
      Selection.Copy
      Sheets("Scoring").Select
      Cells(5 + x, 2).Select
      ActiveSheet.Paste

      x = x + 1

  Loop

Application.ScreenUpdating = True

1 个答案:

答案 0 :(得分:1)

我认为这种方式可能会给你更好的结果:

Sub foo()
Dim x As Long
Dim SearchValue As String
Dim wsScore As Worksheet: Set wsScore = Sheets("Scoring")
Dim wsData As Worksheet: Set wsData = Sheets("Data")
Application.ScreenUpdating = False
' Set numrows = number of rows of data.
NumRows = wsScore.Range("C6", wsScore.Range("C6").End(xlDown)).Rows.Count

For i = 6 To NumRows
    SearchValue = wsScore.Cells(i, 3).Value
    Set FoundVal = wsData.Cells.Find(What:=SearchValue, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False)

    If Not FoundVal Is Nothing Then
        wsScore.Cells(i, 2).Value = FoundVal.Offset(, -1).Value
    End If
Next i

Application.ScreenUpdating = True
End Sub