Question

我想解决的问题是我正在寻找一个函数来查找不同于我写入的工作簿中的文本字符串。目标是找到文档A中的文本（不是代码的来源。只是信息的数据库），在一个框下面写一个"P"，与文本B中的文本相关联。现在我只想搜索文档A并将"P"写入文档B中定义的单元格。

注意：我遗漏了一些其他功能，试图简化我发布的内容注意：代码在这里没有完美显示。我很擅长发帖。抱歉给你带来不便。

我的代码改编自：https://msdn.microsoft.com/en-us/library/office/ff839746.aspx

到目前为止我的代码：

 Sub CommandButton1_Click()
    Dim dataBase As Workbook
    Dim Config As String

    'This makes it so the database will not visibly open
    Application.ScreenUpdating = False


    'this saves the full path name as well as the file name for the Route Chart template/open file
    NegsFilePath = Application.ActiveWorkbook.FullName

    'the getFile function opens up a file explorer in order to select the database. the line
    'below the call for that is the location of it on my computer, and simply there for testing
    'purposes
    Config = GetFile("Select the Config file")
    'Config = "C:\Users\Z003CPYE\Desktop\CP256_M1_Rev2.0.xlsm"

    'this is where we call to the functions that actually grab the data.
    Application.StatusBar = "Importing Data..."
    Call WriteInputs(Config)
    Call FindRoutes(Config)
    Call FindAddress(Config)

    'I do not really know why this is done, but everything I read online said to do this
    'if you set it to false.
    Application.ScreenUpdating = True
End Sub

Function GetFile(prompt As String) As String
    Dim fNameAndPath As Variant

    'This opens the file browser, and filters it for .xlsx and .xlsm files only.
    'NOTE: it recieves prompt when called as an argument, and returns the string
    'of the file that is selected's path.
    fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLSX;*.XLSM), *.XLSX;*.XLSM", Title:=prompt)

    'This is from the function Ifsafd saw online, I believe it is for the exit/close
    'and cancel button being clicked
    If fNameAndPath = False Then
    Call stopAllMacros
    End If

    GetFile = fNameAndPath

End Function

Sub stopAllMacros()
    Application.ScreenUpdating = True
    End
End Sub

Sub FindAddress(Config As String)
    Dim NegativesPath As Workbook
    Dim cfg As Workbook
    Dim GCell As Range
    Dim Page$, Txt$, MyPath$, MyWB$, MySheet$


    Set NegativesPath = ActiveWorkbook
    Set cfg = Workbooks.Open(Config)

    'The text for which to search.
    Txt = "1E Sig"
    'The path to the workbook in which to search.
    MyPath = "C:\Users\z003njcy\Desktop\"
    'The name of the workbook in which to search.
    MyWB = "CP256_M1_Rev2.0.xlsm"

    'If an error occurs, use the error handling routine at the end of this file.
    On Error GoTo ErrorHandler

    'Turn off screen updating, and then open the target workbook.
    Application.ScreenUpdating = False


    'Search for the specified text in master file
    Set GCell = cfg.Worksheets("Location Input").Cells.Find(Txt)

    'Record the address of the data, along with the date, in sheet5 B4.
    With Project.Worksheets.Range("B4")
        .Value = Txt
        .Offset(0, 1).Value = "P"
        .Columns.AutoFit
        .Offset(1, 1).Columns.AutoFit
    End With

    'Close the data workbook, without saving any changes, and turn screen updating back on.
    ActiveWorkbook.Close savechanges:=False
    Application.ScreenUpdating = True
    Exit Sub

    'Error Handling section.
ErrorHandler:
    Select Case Err.Number
    'Common error #1: file path or workbook name is wrong.
    Case 1004
    Range("D10:E11").ClearContents
    Application.ScreenUpdating = True
    MsgBox "The workbook " & MyWB & " could not be found in the path" & vbCrLf & MyPath & "."


    Exit Sub

    'Common error #2: the specified text wasn't in the target workbook.
    Case 9, 91
    ThisWorkbook.Sheets(MySheet).Range("D10:E11").ClearContents
    Workbooks(MyWB).Close False
    Application.ScreenUpdating = True
    MsgBox "The value " & Txt & " was not found."
    Exit Sub

    'General case: turn screenupdating back on, and exit.
    Case Else
    Application.ScreenUpdating = True
    Exit Sub
    End Select

End Sub

VBA查找和编写函数

0 个答案: