VBA数据搜索，选择，复制和过去新工作表

时间：2015-12-17 08:13:10

标签： excel vba excel-vba

我有一个永远不会改变的数据库表，我每天都会得到包含大量数据的多个文档......我想要的是一个工具/代码，用于在新文档中搜索数据库中的数据表格，并将其复制到新表格。

我找到了一个搜索数据的VBA代码，但我必须在输入框中插入我正在寻找的内容。

    Sub FindText()
     Dim ws As Worksheet, Found As Range
     Dim myText As String, FirstAddress As String
     Dim AddressStr As String, foundNum As Integer

      myText = InputBox("Enter text to find")

     If myText = "" Then Exit Sub

      Sheets("Search").Select
      Range("A2:L625748").Select
      Selection.ClearContents
      Range("A1").Select

     For Each ws In ThisWorkbook.Worksheets
     With ws
      'Do not search Search sheet
     If ws.Name = "Gevonden" Then GoTo myNext

      Set Found = .UsedRange.Find(what:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

      If Not Found Is Nothing Then
      FirstAddress = Found.Address

      Do
      foundNum = foundNum + 1
      AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf

      Set Found = .UsedRange.FindNext(Found)

      'Copy found data row to sheet4 Option!
       Found.EntireRow.Copy _
       Destination:=Worksheets("Search").Range("A65536").End(xlUp).Offset(1, 0)
       Loop While Not Found Is Nothing And Found.Address <> FirstAddress
      End If

        myNext:
      End With

        Next ws

       If Len(AddressStr) Then
       MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
       AddressStr, vbOKOnly, myText & " found in these cells"
       Else:

       MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
        End If
        End Sub

2 个答案:

答案 0 :(得分：0)

直接的方法是编写VBA代码。但是，由于您需要做大量的手工工作，因此最好保留它＆＃34;手册＆＃34;。

要快速检查新项目，可以使用VLOOKUP函数来存在记录。添加具有正确VLOOKUP的新列，然后过滤那些不是＆＃34; #N / A＆＃34;。下次当您需要覆盖新数据时，只需粘贴数据即可完成工作。

答案 1 :(得分：0)

经过Google的一些尝试和大量帮助，我做了一些有用的东西，但为了实现我想要的东西，我仍然需要删除一些带有“//”和“Local”字样的行。 你们有人可以帮助我吗？这是我到目前为止所做的：

Public Sub FindInput()
'Run from standard module, like: Module1.
'Find all data on all sheets!
'Do not search the sheet the found data is copied to!
'List a message box with all the found data addresses, as well!
  Dim ws As Worksheet, Found As Range
  Dim myText As String, FirstAddress As String
  Dim AddressStr As String, foundNum As Integer

  myText = (":I.")

  If myText = "" Then Exit Sub

  Sheets("Inputs").Select
  Range("A2:L625748").Select
  Selection.ClearContents
  Range("A1").Select

  For Each ws In ThisWorkbook.Worksheets
  With ws
  'Do not search Search sheet
   If ws.Name = "Inputs" Then GoTo myNext

   Set Found = .UsedRange.Find(What:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)

    If Not Found Is Nothing Then
    FirstAddress = Found.Address

      Do
        foundNum = foundNum + 1
        AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf

     Set Found = .UsedRange.FindNext(Found)

    'Copy found data row to sheet4 Option!
     Found.EntireRow.Copy _
     Destination:=Worksheets("Inputs").Range("A65536").End(xlUp).Offset(1, 0)
     Loop While Not Found Is Nothing And Found.Address <> FirstAddress
     End If

     myNext:
     End With

     Next ws


      Cells.Replace What:="'", Replacement:="", LookAt:=xlPart, SearchOrder:= _
    xlByColumns, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

      Cells.Replace What:="NOT", Replacement:="", LookAt:=xlPart, SearchOrder:= _
    xlByColumns, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False


      Columns("A:A").Select
      Selection.Replace What:=":", Replacement:="", LookAt:=xlPart, _
         SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
          ReplaceFormat:=False

          Columns("A:A").Select
        Selection.Replace What:="(", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False

     Columns("B:B").Select
    Selection.Replace What:=".Data", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:="Data", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:="Ch", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".0", Replacement:=".00", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".1", Replacement:=".01", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".2", Replacement:=".02", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".3", Replacement:=".03", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".4", Replacement:=".04", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".5", Replacement:=".05", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".6", Replacement:=".06", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".7", Replacement:=".07", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".8", Replacement:=".08", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".9", Replacement:=".09", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".010", Replacement:=".10", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".011", Replacement:=".11", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".012", Replacement:=".12", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".013", Replacement:=".13", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".014", Replacement:=".14", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".015", Replacement:=".15", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".016", Replacement:=".16", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".017", Replacement:=".17", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".018", Replacement:=".18", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".019", Replacement:=".19", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".020", Replacement:=".20", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".021", Replacement:=".21", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".022", Replacement:=".22", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".023", Replacement:=".23", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".024", Replacement:=".24", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".025", Replacement:=".25", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".026", Replacement:=".26", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".027", Replacement:=".27", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".028", Replacement:=".28", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".029", Replacement:=".29", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".030", Replacement:=".30", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Selection.Replace What:=".031", Replacement:=".31", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Dim D As Range

    Columns("B:B").Select

    For Each D In Selection
     If Left(D.Value, 1) = " " Then
     D.Value = Right(D.Value, Len(D.Value) - 1)
    End If
    Next D

 End Sub
相关问题
最新问题