VBA數據搜索，選擇，複製和過去在新工作表

-1

我有一個永遠不會改變的數據庫工作表，我每天都有多個文件與大量的數據...我想要的是一個工具/代碼在新文檔中搜索數據庫表中的數據，並將其複製到新工作表。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

來源

2015-12-17 Nito Nascimento

請告訴我們你到目前爲止試過的東西。如果你有問題，我們可以幫助你，但我們不會爲你實施這整個「工具/代碼」。尤其是沒有這個小細節。 – blckbird

對不起，我忘了給我已經有的東西。現在我可以搜索，但只能在輸入框中輸入內容，我希望它能夠比較兩張圖片並複製/粘貼相似的數據。 –

直接的方法是編寫VBA代碼。但是，由於您需要進行大量手動工作，因此最好保持「手動」。

要快速檢查新項目，可以使用VLOOKUP函數來存在記錄。用正確的VLOOKUP添加一個新列，然後過濾那些不是「＃N/A」的列。下一次當您需要覆蓋新數據時，只需粘貼數據，它就可以完成這項工作。

來源

2015-12-17 09:23:27 Jensan

經過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

來源

2016-01-06 08:36:09

VBA數據搜索，選擇，複製和過去在新工作表

回答

相關問題