Question

我正在尝试使用VBA请某人选择一个Excel文件，如果该文件符合条件，我想将某些列输出到新工作簿。

我开始创建允许用户选择文件的脚本，然后尝试测试是否可以看到一些数据输出，但我不知所措。我的逻辑似乎已经过时了！我提供了以下代码。它似乎没有多大意义，但在我出轨之前，我的想法是：

用户打开Excel文件（宏在其中）
运行脚本时，将打开浏览面板以选择Excel文件
如果该Excel文件（工作簿）包含单元格8中的字符串（也是循环），则输出新工作簿中的列范围。

以下是代码：

Sub Import2()
Dim Input_Workbook As Workbook
Dim Output_Workbook As Workbook
Dim Source_Path As String
Dim LastRow As Long, erow As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Source_Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS*), *.XLS*", Title:="Select File To Be Opened")

Set Input_Workbook = Workbooks.Open(Source_Path)

For i = 2 To LastRow
    If Cells(i, 8) = "231/8151" Then
        Range(Cells(i, 1), Cells(i, 7)).Select
        Selection.Copy
        Set Output_Workbook = ThisWorkbook
        Set Input_Workbook = Workbooks.Open(Source_Path)
        Imported_Workbook.Sheets(1).Select
        erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

        Input_Workbook.Cells(erow, 1).Select
        Input_Workbook.Paste
        Input_Workbook.Save
        Input_Workbook.Close
        Input_Workbook = False
    End If

    Output_Workbook.Save
    Input_Workbook.Save
    Input_Workbook.Close False

Next i
End Sub

Answer 1

您似乎已经互换了输入和输出工作簿。您打开工作簿的方法是正确的，但是您需要预测用户Cancelling或Closing对话框。

Dim Source_Path As Variant ' Declare as Variant and not as string
Source_Path = Application.GetOpenFileName("Excel Files (*.xls*), *.xls*", , _
                                          "Select File To Be Opened", ,True)

If Not IsArray(Source_Path) Then Msgbox "No File Selected. Exiting Now": Exit Sub

现在请注意输入和输出工作簿。

Dim Input_Workbook As Workbook, Output_Workbook As Workbook
Set Output_Workbook = ThisWorkbook: Set Input_Workbook = Workbooks.Open(Source_Path)

现在您需要在Input_Workbook签入哪张工作表？我假设你只有一个工作表：

Dim what_to_find As String, found_rng As Range
Dim LastRow As Long

Dim Output_Worksheet As Worksheet: Set Output_Worksheet = Output_Workbook.Sheets(1)
what_to_find = "231/8151"

With Input_Workbook.Sheets(1)
    Set found_rng = .Range("H:H").Find(what_to_find) 'execute find first
    If found_rng Is Nothing Then MsgBox "No Match Found. Exiting Now.": Exit Sub
    LastRow = .Range("H" & .Rows.Count).End(xlup).Row
    ' Now, an alternative to looping is using AutoFilter Method
    .Range("A1:H" & LastRow).AutoFilter 8, what_to_find ' filter all matches
    .Range("A2:G" & LastRow).SpecialCells(xlCellTypeVisible).Copy

    Output_Worksheet.Range("A" & Output_Worksheet.Rows.Count).End(xlUp).Offset(1, 0) _
        .PasteSpecial xlPasteValues ' or xlPasteAll
End With

其他假设包括：

您真正匹配或搜索文本或字符串，而不是公式或其中的一部分。
您需要复制值，而不是公式。否则，请使用xlPasteAll

另外，check this out了解如何避免使用选择并熟悉使用对象的方法。你实际上非常接近，你只是对循环中的复制和粘贴部分感到困惑。希望这个和我推荐的链接指导您使代码工作并帮助您完成所需的工作。

导入Excel工作簿并输出一些行和＆amp;基于条件的列

1 个答案: