Question

更具体地说，我需要的是查找列中的所有唯一值（这些值是一年中几个月的数字表示）并使用返回的值创建一个弹出框，允许用户选择要运行的宏。例如，我将报表数据导入到包含100条记录的工作表中。在B栏中，我们将看到代表11月和12月的11和12。我要做的是捕获这两个数字并使用它来允许用户运行11月或12月的代码。我添加了用于11月的代码作为示例。

Sub Extract_Sort_1511_November()
'
'

' This line renames the worksheet to "Extract"
Application.ScreenUpdating = False
    ActiveSheet.Name = "Extract"

' This line autofits the columns C, D, O, and P
    Range("C:C,D:D,O:O,P:P").Select
    Range("P1").Activate
    Selection.Columns.AutoFit
    Range("A2").Select

' This unhides any hidden rows
Cells.Select
    Selection.EntireRow.Hidden = False
    Range("A2").Select

' Want to alter the code below to perform a query in column B to determine
' which months are listed from the import, then use the results in a dialog box to
' allow the user to choose which month to view

Dim LR As Long

    For LR = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("B" & LR).Value <> "11" Then
            Rows(LR).EntireRow.Hidden = True
        End If
    Next LR

With ActiveWorkbook.Worksheets("Extract").Sort
    With .SortFields
        .Clear
        .Add Key:=Range("B2:B2000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    End With
    .SetRange Range("A2:Z2000")
    .Apply
End With
Cells.WrapText = False
Sheets("Extract").Range("A2").Select
Application.ScreenUpdating = True
End Sub

Answer 1

找到更快的方法来实现此问题的真正目标。更改了排序和隐藏部分的顺序。这现在产生了预期的结果。

Sub Extract_Sort_1511_November()
'
'

' This line renames the worksheet to "Extract"
Application.ScreenUpdating = False
    ActiveSheet.Name = "Extract"

' This line autofits the columns C, D, O, and P
    Range("C:C,D:D,O:O,P:P").Select
    Range("P1").Activate
    Selection.Columns.AutoFit
    Range("A2").Select

' This unhides any hidden rows
Cells.Select
    Selection.EntireRow.Hidden = False
    Range("A2").Select

' Want to alter the code below to perform a query in column B to determine
' which months are listed from the import, then use the results in a dialog box to
' allow the user to choose which month to view

Dim LR As Long

With ActiveWorkbook.Worksheets("Extract").Sort
    With .SortFields
        .Clear
        .Add Key:=Range("B2:B2000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    End With
    .SetRange Range("A2:Z2000")
    .Apply
End With

    For LR = Range("B" & Rows.Count).End(xlUp).Row To 2 Step -1
        If Range("B" & LR).Value <> "11" Then
            Rows(LR).EntireRow.Hidden = True
        End If
    Next LR

Cells.WrapText = False
Sheets("Extract").Range("A2").Select
Application.ScreenUpdating = True
End Sub

需要根据列中的值运行宏

1 个答案: