Question

我有一个非常基本的VBA技能，所以我首先要说的是我非常感谢任何能够花时间协助我解决问题的人。关于这个一般主题有很多帖子，但我希望附加一个我正在使用并且非常喜欢的现有代码。

以下代码从消息框中的搜索值（A）返回关联值（B：C）。我需要一个额外的脚本来获取消息框搜索结果并将它们（以及搜索到的值）写入另一个表格（比方说我们称之为＆＃34; TVD REPORT＆＃34;）。我仍然希望保留以下代码来显示消息，还要存储搜索结果。这看起来非常简单，但是融入现有代码是我的想法。

注意：表格（＆＃34;数据＆＃34;）。选择就在那里，以便每次执行事件时脚本在后台运行，因为表格将受到保护。

Dim rngVis As Range
Dim VisCell As Range
Dim sFind As String

sFind = InputBox("Please enter the MD Depth to find the matching TVD depth and VS footage.")

If Len(Trim(sFind)) = 0 Then Exit Sub   'Pressed cancel

Application.ScreenUpdating = False
Sheets("MD REPORT").Select
With Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("A"))
    .AutoFilter 1, sFind
    On Error Resume Next
    Set rngVis = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    .AutoFilter
End With

'appended script to paste results into new sheet goes here??

Sheets("Data").Select
Application.ScreenUpdating = True

If rngVis Is Nothing Then
    MsgBox sFind & " could not be found."
Else
    For Each VisCell In rngVis.Cells
        MsgBox "TVD: " & VisCell.Worksheet.Cells(VisCell.Row, "B").Text & vbNewLine & _
               "VS: " & VisCell.Worksheet.Cells(VisCell.Row, "C").Text
    Next VisCell
End If

End Sub

Answer 1

Sub Zach()

Dim rngVis As Range
Dim VisCell As Range
Dim sFind As String
Dim rpt As Worksheet
Set rpt = ActiveWorkbook.Worksheets("TVD REPORT") 'assuming this sheet is in same workbook
Dim tvd As String
Dim vs As String

sFind = InputBox("Please enter the MD Depth to find the matching TVD depth and VS footage.")

If Len(Trim(sFind)) = 0 Then Exit Sub   'Pressed cancel

Application.ScreenUpdating = False
Sheets("MD REPORT").Select
With Intersect(ActiveSheet.UsedRange, ActiveSheet.Columns("A"))
    .AutoFilter 1, sFind
    On Error Resume Next
    Set rngVis = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    .AutoFilter
End With

Sheets("Data").Select
Application.ScreenUpdating = True

If rngVis Is Nothing Then
    MsgBox sFind & " could not be found."
Else
    For Each VisCell In rngVis.Cells
        tvd = VisCell.Worksheet.Cells(VisCell.Row, "B").Text
        vs = VisCell.Worksheet.Cells(VisCell.Row, "C").Text
        MsgBox "TVD: " & tvd & vbNewLine & "VS: " & vs
        lastRow = rpt.Cells(rpt.Rows.Count, "A").End(xlUp).Row
        'dropping it in columns A and B. Change as necessary
        rpt.Cells(lastRow + 1, 1) = tvd
        rpt.Cells(lastRow + 1, 2) = vs
    Next VisCell
End If

End Sub

将搜索结果写入现有搜索功能中的新工作表

1 个答案: