Question

现在我已经设置了多个宏，我想将其缩减为一个。首先，用户输入他们正在寻找的所需部件号，宏将在下拉列表中返回与该部件号相关联的所有不同版本。接下来，用户将从他们想要查看的下拉列表中选择版本，下一个宏将找到与其关联的名称。

有没有办法让宏等待用户输入值然后再继续执行代码？

这是第一个宏

Dim part As String


Application.ScreenUpdating = False


'Filter based on user entry
Sheets("New Revision ").Select
    part = Range("B4").Value
    Sheets("PN_List").Select
    Columns("D:E").Select
    Selection.EntireColumn.Hidden = False
    ActiveSheet.Range("$A$1:$K$3000").AutoFilter Field:=1, Criteria1:=part

'Take current version and filter it to bottom of the list
  ActiveWorkbook.Worksheets("PN_List").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("PN_List").AutoFilter.Sort.SortFields.Add Key:= _
        Range("E1:E3000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("PN_List").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With



'Version Number
Worksheets("PN_List").Activate
Range("B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("table_converter").Visible = True
Sheets("table_converter").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1", Selection.End(xlDown)), xlNo).Name = _
        "master"
        ActiveSheet.ListObjects("master").ShowHeaders = False
   Range("master[#All]").Select
    ActiveWorkbook.Names.Add Name:="converter", RefersToR1C1:= _
        "=master[#All]"
    ActiveWorkbook.Names("converter").Comment = ""
     'ActiveSheet.ListObjects("master").ShowHeaders = False



'Range(Selection, Selection.End(xlDown)).Select
    'Range(Selection, Selection.End(xlDown)).Select
    'val = Range(Selection, Selection.End(xlDown)).Value

Worksheets("New Revision ").Activate
'Range("B7").Select
 '   With Selection.Validation
  '     .Delete
   '    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    '    xlBetween, Formula1:=r
     '  .IgnoreBlank = True
      ' .InCellDropdown = True
       '.InputTitle = ""
       '.ErrorTitle = ""
       '.InputMessage = ""
        '.ErrorMessage = ""
        '.ShowInput = True
        '.ShowError = True
    'End With



'Return PN_List to normal form
    Worksheets("PN_List").Activate
    ActiveSheet.Range("$A$1:$K$3000").AutoFilter Field:=1
    Columns("A:K").Select
    ActiveWorkbook.Worksheets("PN_List").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("PN_List").Sort.SortFields.Add Key:=Range( _
        "A2:A3000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("PN_List").Sort.SortFields.Add Key:=Range( _
        "E2:E3000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("PN_List").Sort
        .SetRange Range("A1:K3000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.AutoFilter


'hide key colunm
Worksheets("PN_List").Activate
Columns("D:E").Select
Selection.EntireColumn.Hidden = True
Range("A1").Select
  Worksheets("New Revision ").Activate

  Sheets("table_converter").Visible = False

  'Entry does not exsit
 ' If Worksheets("New Revision ").Range("B4") = "" Then
  'MsgBox "Part Number Not found. Please refer to the PN List.", vbOKOnly + vbExclamation, "Entry Error"
  'End If

 ' If Worksheets("New Revision ").Range("B6") = "" Then
 'Worksheets("New Revision ").Range("B4").ClearContents
 'End If
End Sub

这是第二个宏

Dim ver_num As String
    Dim prt_num As String

    Application.ScreenUpdating = False

    'Clear Previous Data in Search Version Number
      Sheets("table_converter").Visible = True
      Sheets("table_converter").Select
      Columns("A:A").Select
        Selection.Delete Shift:=xlToLeft
        On Error Resume Next
         ActiveWorkbook.Names("converter").Delete

    'Retrun Part Name
    Sheets("New Revision ").Select
    Range("B4").Select
    ver_num = Selection.Value
    Range("B6").Select
    prt_num = Selection.Value
    Sheets("PN_List").Select

    'Find part name
     ActiveSheet.Range("$A$1:$K$3000").AutoFilter Field:=1
     ActiveSheet.Range("$A$1:$K$3000").AutoFilter Field:=1, Criteria1:=ver_num
     ActiveSheet.Range("$A$1:$K$3000").AutoFilter Field:=2, Criteria1:=prt_num
    Range("F1").End(xlDown).Offset(0, 0).Select
    Selection.Copy
    Sheets("New Revision ").Select
    Range("B8").Select
    ActiveCell.PasteSpecial
    With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Selection.Font.Bold = True
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 15773696
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With

    'Filter List back to normal
         Sheets("PN_List").Select
         Columns("D:E").Select
        Selection.EntireColumn.Hidden = False
         Selection.AutoFilter
        Columns("A:A").Select
        ActiveWorkbook.Worksheets("PN_List").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("PN_List").Sort.SortFields.Add Key:=Range( _
            "A2:A3000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        ActiveWorkbook.Worksheets("PN_List").Sort.SortFields.Add Key:=Range( _
            "E2:E3000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
            xlSortNormal
        With ActiveWorkbook.Worksheets("PN_List").Sort
            .SetRange Range("A1:L3000")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    Columns("D:E").Select
        Selection.EntireColumn.Hidden = True
        Range("A1").Select
        Sheets("New Revision ").Select
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlDouble
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThick
        End With
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    Sheets("table_converter").Visible = False

    End Sub

Answer 1

像value = Inputbox("Input a value : ")？

之类的东西

修改 要详细了解，您可以执行类似

的操作

Sub valueMenu()

    myValue = InputBox("Input a value : ")
    If myValue = 1 Then
        'Call Macro1
        Macro1
    ElseIf myValue = 2 Then
        'Call Macro2
        Macro2
    End If

End Sub

Sub Macro1()
    'Do something
End Sub

Sub Macro2()
    'Do something else
End Sub

如何使用动态列表运行宏

1 个答案: