Excel 宏搜索文本，然后复制 1 个单元格并将其粘贴到工作表 2 的新行中答案

【问题标题】：Excel macro to search a txt then copy 1cell and paste it in a new row in sheet 2Excel 宏搜索文本，然后复制 1 个单元格并将其粘贴到工作表 2 的新行中
【发布时间】：2013-12-28 09:34:42
【问题描述】：

我有一个巨大的 Excel 表（超过 11K 行，只有 11 列）供客户使用。我试图只打印我的 11K 客户中的 1800 名客户的姓名，这些客户还没有收到我办公室里的身份证。每张身份证都有一个唯一的条形码编号，它包含在我的 Excel 表列“H”中他们的名字在'F'列中

我想做的是：

使用我的条形码阅读器输入每个 ID 卡条形码的消息框。然后，在“H”列中搜索，找到所需的客户后，然后复制“F”列中的客户名称，并将其粘贴到表 2 中的新行。

所以

Excel 表中是否有函数或宏可以帮助我做到这一点？或者有人有更好的想法吗？我尝试录制宏，但效果不佳:'( 任何帮助将不胜感激

亲切的问候:)

这段代码完成了我的工作，但是我怎么能把固定的字符串改成输入框，所以我搜索我正在寻找的东西

Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 4
LSearchRow = 4

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

  'If value in column E = "Mail Box", copy entire row to Sheet2
  If Range("E" & CStr(LSearchRow)).Value = "Mail Box" Then

     'Select row in Sheet1 to copy
     Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
     Selection.Copy

     'Paste row into Sheet2 in next row
     Sheets("Sheet2").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("Sheet1").Select

  End If

  LSearchRow = LSearchRow + 1

 Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
 MsgBox "An error occurred."

End Sub

【问题讨论】：

P.S 对不起我的英语不好:)
如果您将条形码读入 Sheet2 ColA，那么您可以在 ColB 中使用 VLOOKUP() 从主工作表中读取名称（但您需要切换条形码列，使其位于名称列）
听起来像 VLOOKUP?
从事扫描工作的人不擅长编码，所以我提供了一个我坚持下来的帮助。我需要的更像是stackoverflow.com/questions/20482207/…

标签： vba excel

【解决方案1】：

看看这是否有帮助。我不太确定你是想要复制名字还是整行。此代码只是复制名称单元格，但很容易修改为整行。

Sub SrchIDs()
    Dim rId As Range, celS As Range, celT As Range
    Dim wS As Worksheet, wT As Worksheet
    Dim sId As String

    Set wS = Worksheets("Sheet1")
    Set wT = Worksheets("Sheet2")
    Set celT = wT.Range("A2")

     Do

        sId = InputBox("Enter ID")
        If Len(sId) = 0 Then Exit Sub

        Set rId = wS.Range("H4") 'start of search area
        Set rId = wS.Range(rId, wS.Cells(wS.Rows.Count, rId.Column).End(xlUp)) 'rest of data

        Set celS = rId.Find(sId, , xlValues, xlWhole, , , False)

        If Not celS Is Nothing Then
            Set celS = Intersect(wS.Columns("F:F"), celS.EntireRow) 'extract name
            If Not IsEmpty(celT) Then 'find next empty cell in target sheet
                Set celT = wT.Cells(wT.Rows.Count, celT.Column).End(xlUp).Offset(1)
            End If
            celT.Value = celS.Value
        End If

    Loop Until Len(sId) = 0

End Sub

【讨论】：