VBA：复制和粘贴，然后搜索，复制和粘贴

2 回答

• 0

  这是我的第一个答案，它只是整理您现有的代码 . 我的所有更改和添加都标有“引用哈希” . 研究我所做的改变，并试着理解我为什么做出这些改变 . 我计划另外两个答案 .

  Option Explicit         '# Always include this statement at top
  Sub SearchForString()
  
    Dim LSearchRow As Long        '# Integer creates 16-bit value which requires
    Dim LCopyToRow As Long        '# special processing on post-16-bit computers
    Dim LSearchValue As String
  
    Dim WshtSrc As Worksheet      '# Faster and more convenient if you are
    Dim WshtDest As Worksheet     '# working with more than one worksheet
  
    Set WshtSrc = Worksheets("Search")  '# These are probably the wrong
    Set WshtDest = Worksheets("Dest")   '# worksheet names
  
    '# I never use "On Error GoTo label" while developing macros because I want to
    '# know where an error occurs. Before release, I check for every condition that
    '# might lead to an error if possible.  If I cannot stop the possibility of an
    '# error, I will use "On Error Goto Next" and "On Error GoTo 0" either side of
    '# a problem statement and I will then test Err.  This will allows me to issue a
    '# useful message to the user even if I cannot do better.
    '# On Error GoTo Err_Execute
  
    LSearchValue = InputBox("Please enter the staff ID.", "Enter value")
  
    'Start search in row 5
    LSearchRow = 6
  
    'Start copying data to row 5 in Sheet1 (row counter variable)
    LCopyToRow = 5
  
    With WshtSrc
  
      While Len(.Range("A" & CStr(LSearchRow)).Value) > 0                 '#
  
        'If value in column A = LSearchValue, copy entire row to Sheet1
        If .Range("A" & CStr(LSearchRow)).Value = LSearchValue Then       '#
  
        .Rows(LSearchRow).Copy Destination:=WshtDest.Cells(LCopyToRow, 1)
  
          '# 'Select row in Sheet1 to copy
          '# Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
          '# Selection.Copy
  
          '# 'Paste row into Sheet1 in next row
          '# Sheets("Search").Select
          '# Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
          '# ActiveSheet.Paste
  
          'Move counter to next row
          LCopyToRow = LCopyToRow + 1
  
          '# 'Go back to Sheet1 to continue searching
          '# Sheets("Search").Select
  
        End If
  
        LSearchRow = LSearchRow + 1
  
      Wend
  
      'Position on cell A3
      'Range("A3").Select
  
    End With
  
    Exit Sub
  
  '# Err_Execute:
  '#    MsgBox "An error occurred."
  
  End Sub
  

  Answer 2

  在 LSearchValue = InputBox("Please enter the staff ID.", "Enter value") 之后添加：

  If LSearchValue = "" Or LSearchValue = "Enter value" Then
      ' User does not want to make a selection
      Exit Sub
    End If
  
    WshtDest.Cells.EntireRow.Delete
  
    '# Copy heading rows
    WshtSrc.Rows("1:4").Copy Destination:=WshtDest.Range("A1")
  

  我应该在第一个答案中包括前五行 . 总是给用户提供一种说法：“打扰！我不是故意这样做”并且退出他们所做的选择 . 我应该在开始新选择之前清除之前选择的目标表 .

  最后的陈述是我知道复制四行的最简单方法 .

  我注意到我的第一个答案出错了 . 我错过了两个必要的变化：

  While Len(.Range("A" & CStr(LSearchRow)).Value) > 0
  
        If .Range("A" & CStr(LSearchRow)).Value = LSearchValue Then
  

  我省略了Range前面的句号 . Range 在活动工作表上运行 . .Range 对 With 语句中指定的工作表进行操作 .

  Answer 3

  我在这个问题上不是很好，所以我就是那个叫水壶黑的锅 . 使用Excel的强大功能 . 如果Excel具有您想要的功能，那么请使用它 .

  对于我的测试数据，我有四列，我的员工ID是字母A到D.为了得到下面的宏，我：

  • 打开宏录像机

  • 选择了前四列

  • 选择AutoFilter将其打开

  • 单击A列顶部的箭头，然后单击值B.

  • 选择AutoFilter将其关闭

  • 关闭宏录制器

  .

  Sub Macro2()
  '
  ' Macro2 Macro
  ' Macro recorded 21/05/2014 by Tony Dallimore
  '
  
  '
      Columns("A:D").Select
      Selection.AutoFilter
      Selection.AutoFilter Field:=1, Criteria1:="B"
      Selection.AutoFilter
  End Sub
  

  在第二个AutoFilter语句之后，如果用户选择人员ID B，屏幕几乎就是您要复制的内容 . “几乎完全”是因为第2行到第4行是不可见的 . 如果有一种方法告诉AutoFilter你有四个 Headers 行，那么我不知道它，所以我将以不同的方式解决这个问题 .

  宏 Logger 不知道您的目标 . 这段代码在语法上是正确的，但它不是很好的代码，因此必须对其进行整理 . 此外，它不会复制行，因为我已经知道如何做到这一点 . 下面的宏更小，如果你有很多行，速度要快得多 .

  Sub SearchForString2()
  
    Dim LSearchValue As String
  
    Dim RngCopy As Range
    Dim RngData As Range
  
    Dim WshtSrc As Worksheet
    Dim WshtDest As Worksheet
  
    ' I should have included this in answer 1.  It stops the screen being repainted
    ' as the worksheets are changed which is both slow and irritating because of
    ' the flashing.
    Application.ScreenUpdating = False
  
    Set WshtSrc = Worksheets("Search")  '# These are probably the wrong
    Set WshtDest = Worksheets("Dest")   '# worksheet names
  
    LSearchValue = InputBox("Please enter the staff ID.", "Enter value")
  
    WshtDest.Cells.EntireRow.ClearContents
  
    If LSearchValue = "" Or LSearchValue = "Enter value" Then
      ' User does not want to make a selection
      Exit Sub
    End If
  
    With WshtSrc
  
      Set RngData = .Columns("A:D")   '   Change column range as necessary
  
      RngData.AutoFilter    ' Switch AutoFilter on.
      RngData.AutoFilter Field:=1, Criteria1:=LSearchValue
      .Rows("2:4").Hidden = False
  
      Set RngCopy = .Cells.SpecialCells(xlCellTypeVisible)
  
      RngCopy.Copy Destination:=WshtDest.Range("A1")
  
      RngData.AutoFilter ' Switch AutoFilter off.
  
    End With
  
  
    ' Note that there is no period before RngData or RngCopy.
    ' When you set a range, the worksheet is part of the range.
    ' So Columns is a "child" of WshtSrc but RngData and RngCopy are not.
    ' The following statement shows that RngData "knows" what worksheet
    'it applies to.
  
    Debug.Print "RngData's worksheet: " & RngData.Worksheet.Name
  
    Exit Sub
  
  End Sub
  

  回复于 2024-04-24T18:00:40+08:00
• 1

  您可以在搜索代码时使用此代码：

  Selection.Find(What:=LSearchValue, After:=ActiveCell, LookIn:=xlValues, LookAt _
      :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
      True, SearchFormat:=False).Activate
  Dim valuerow As Integer
  valuerow = Application.ActiveCell.Row
  

  valuerow 是找到的单元格的行索引

  回复于 2024-04-24T18:00:40+08:00