☰

宏或 VBA 用于选择从弹出窗口调用的列中的第一个空单元格，其中有 3 个选项，宏 1、宏 2 或取消

tag-icon • tag-icon microsoft-excel vba macros
宏或 VBA 用于选择从弹出窗口调用的列中的第一个空单元格，其中有 3 个选项，宏 1、宏 2 或取消

Windows 7的

Excel 2016

之前在我使用 Excel 2007 时曾被问过一些问题，但我最终设法从工作的地方带回家一台装有 Excel 2016 的笔记本电脑，因为这是该工作簿要使用的版本。

我尝试使用我在谷歌搜索问题时找到的宏，但没有成功，但我无法让它工作

VBA 和/或宏对我来说很新，所以我想寻求帮助，以便我可以学习。

我有一本工作簿，其中有多张工作表，这些工作表从名为 Data_Import 的工作表的 A 列中的字符串中提取数据，随着时间的推移，我将从 A 列中的第一个空单元格开始向其中添加新字符串。

我已经有一个可以工作的宏，它可以为我导入新的字符串，但这依赖于用户手动检查然后选择 Data_Import 页面的 A 列中的第一个空单元格，或者用户可以清除所有现有数据并手动选择单元格 A1，然后运行导入数据宏。

由于我不是唯一使用该工作簿的人，因此使用宏和弹出表单尽可能自动执行某些任务是有意义的。

我已经在功能区栏上创建了一个名为的选项卡，Data_Import其中有一个按钮，用户可以从工作簿中的任何位置单击该按钮并运行导入宏，但我需要它更加灵活，具有几个用户选择的选项，我希望它可以按如下方式工作：

  1. 用户点击功能区栏上的按钮。
  2. 弹出选项框，其中包含以下按钮，供用户单击，每个按钮上方或内部都有简短标题。按钮 1 = 清除所有现有数据并导入新数据按钮 2 = 将新数据添加到现有数据末尾按钮 3 = 取消

如果用户单击按钮 1，则会弹出一条警告消息“警告 - 您即将覆盖现有数据，您确定吗？然后要求做出是/否的决定......

如果选择“是”按钮，则我的现有宏将运行并清除 Data_Import 工作表的 A 列中的所有数据，选择 Al 并导入新的字符串。

如果没有选择任何按钮，则会显示选项框，用户可以选择按钮 2 或全部取消。

如果用户单击按钮 2，则会弹出一条警告消息“警告 - 您即将向现有数据中添加新数据，您确定吗？然后要求用户做出是/否的决定。

A:A如果选择了“是”按钮，则将运行一个宏，该宏将查看工作表中的范围Data_Import并选择第一个空单元格并从该单元格开始导入新数据。因此，如果有数据，Cells A1 - A100则它应该开始在cell A101

如果用户单击按钮 3，则会弹出一条警告消息“您尚未导入任何新数据，您确定要取消吗？是/否。如果单击“是”，则选项框关闭；如果单击“否”，则警告框关闭，从而允许用户进行新的选择。

它看起来很复杂，但本质上只有 3 个步骤和（希望）两个宏。

目前我已连续调用三个宏来导入数据。

第一个宏。单击功能区按钮时，会弹出一条消息提示，然后设置 Data_Import 页面，选择 A 列的所有内容，清除所有数据，选择单元格 A1。完成后，它会调用名为GetFolderNames

Sub Import_Data()
'Imports folder names into the Data_Import Sheet
'MsgBox function help:
'https://msdn.microsoft.com/en-us/library/office/gg251821%28v=office.15%29.aspx?f=255&MSPPError=-2147217396

Dim Answer As VbMsgBoxResult

    Answer = MsgBox("Are you sure you want to run the macro - Import Folder Names", vbYesNo, "Run Import Folder Names Macro")

    If Answer = vbYes Then
        Sheets("Data_Import").Select
        Columns("A:A").Select
        Selection.ClearContents
        Range("A1").Select

        Call GetFolderNames
    End If

End Sub

第二个宏（不是我的代码，目前大部分代码我都记不清了）。一旦用户选择了要从中导入数据的文件夹，它就会执行数据导入。完成后，它会调用第三个宏，名为Column_Autofit

Sub GetFolderNames()

    Dim xRow&, vSF
    Dim xDirect$, InitialFoldr$

    InitialFoldr$ = "F:\" '<<< Startup folder to begin searching from

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = InitialFoldr$
        .Show
        If .SelectedItems.Count <> 0 Then
            xDirect$ = .SelectedItems(1) & "\"
        End If
    End With

    If xDirect$ <> "" Then
        With CreateObject("Scripting.FileSystemObject").GetFolder(xDirect$)
            For Each vSF In .subfolders
                ActiveCell.Offset(xRow) = Mid(vSF, InStrRev(vSF, "\") + 1)
                xRow = xRow + 1
            Next vSF
        End With

        Call Column_Autofit

    End If
End Sub

第三个宏。这将设置 A 列自动调整宽度

Sub Column_Autofit()

    Columns("A:A").AutoFit

End Sub

至于查找工作表 A 列中第一个空单元格的宏，Data_Import我能找到的最好的东西是下面的代码（不是我的），但我无法让它工作，因为我的技能水平坦率地说还不够好，但我决心学习。

Sub SelectFirstBlankCell()
    Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
    Dim currentRowValue As String

    Sheets("Data_Import").Select
        Columns("A:A").Select

    sourceCol = 1
    rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row

    'for every row, find the first blank cell and select it
    For currentRow = 1 To rowCount
        currentRowValue = Cells(currentRow, sourceCol).Value
        If IsEmpty(currentRowValue) Or currentRowValue = "" Then
            Cells(currentRow, sourceCol).Select

    Call GetFolderNames

        End If
    Next
End Sub

我觉得答案就在我面前，但我却看不到它……如能得到任何建议，我将不胜感激。

答案1

尝试此代码 - 注意它是所有宏的组合：

Sub GetFolderNames()
    Dim Answer As VbMsgBoxResult
    Dim xRow As Long
    Dim vSF As Object
    Dim xDirect$
    Dim InitialFoldr$
    Dim ws As Worksheet: Set ws = Sheets("Data_Import")
    Answer = MsgBox("Are you sure you want to run the macro - Import Folder Names", vbYesNo, "Run Import Folder Names Macro")
    If Answer = vbYes Then
        Application.ScreenUpdating = False
        xRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
        InitialFoldr$ = "F:\" '<<< Startup folder to begin searching from
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = Application.DefaultFilePath & "\"
            .Title = "Please select a folder to list Files from"
            .InitialFileName = InitialFoldr$
            .Show
            If .SelectedItems.Count <> 0 Then
                xDirect$ = .SelectedItems(1) & "\"
            End If
        End With
        If xDirect$ <> "" Then
            With CreateObject("Scripting.FileSystemObject").GetFolder(xDirect$)
                For Each vSF In .subfolders
                    ws.Cells(xRow, 1) = Mid(vSF, InStrRev(vSF, "\") + 1)
                    xRow = xRow + 1
                Next vSF
            End With
            ws.Columns("A:A").AutoFit
        End If
    End If
End Sub

将第 7 行的 Sheets("Data_Import") 更改为您正在使用的任何工作表。让我知道进展如何。

如果您希望将来得到更快的答复，我建议您在提问时可以更简洁一些，因为上面的文字很多。

问候贾斯汀

相关内容