主页 / computer / 问题 / 1559957
Accepted
Kenny
Asked: 2020-06-12 12:00:40 +0800 CST

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

  • 772

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

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

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

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

microsoft-excel vba

1 个回答

  1. Best Answer

    试试这个代码 - 注意它是你所有宏的组合：

    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") 更改为您正在使用的任何工作表。让我知道事情的后续。

    如果您希望将来更快地回答您的问题，我建议您更简洁一点，那是很多文字。

    问候贾斯汀

    • 1

相关问题