Question

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

我想做的是：

使用我的条形码阅读器输入每个身份证条形码的消息框。然后，在找到所需客户后，在“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

Answer 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

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

1 个答案: