EXCEL-VBA-二級菜單交互式自動生成終極版
Function 列號轉(zhuǎn)字母(i As Integer)
Dim chr_re As String
If i >= 0 And i <= 26 Then '如果小于26，直接用chr函數(shù)
????chr_re = Chr(64 + i)
??ElseIf i >= 27 And i <= 256 Then '如果大于26，拼接一下
????chr_re = Chr(64 + i \ 26) & Chr(64 + i Mod 26) 'i \ 26表示i整除26
End If
列號轉(zhuǎn)字母 = chr_re
End Function
Function SheetName(Optional R As Range) As String '鎖死一二級菜單工作表來源，相當于將當前激活表格變量轉(zhuǎn)為常量
??If R Is Nothing Then
????SheetName = Application.Caller.Worksheet.Name
??Else
????SheetName = R.Worksheet.Name
??End If
End Function
Sub 二級下拉菜單自動生成()
??Dim first_list As Range
??Dim first_botton As Range
??Dim first_single As String
??Dim fname As String
??Dim fnameb As String
??Dim fc_chr As String
??Dim fc As Integer
??Dim fr As Integer
??Dim fbc As Integer
??Dim fbr As Integer
????
??On Error Resume Next '忽略錯誤，程序繼續(xù)運行
??Set first_list = Application.InputBox("請框選一級菜單所在區(qū)域", Title:="提示", Type:=8)
??fname = SheetName(first_list)
??fc = first_list.Column
??fcount_first = first_list.Columns.Count
??fc_chr = 列號轉(zhuǎn)字母(fc)
??'first_last_chr = 列號轉(zhuǎn)字母(fc + fcount - 1)
??fr = first_list.Row
??For i = 1 To fcount_first
????first_single = 列號轉(zhuǎn)字母(i + fc - 1) & CStr(65536)
????first_last_row = Range(first_single).End(xlUp).Row
????Sheets(fname).Range(列號轉(zhuǎn)字母(i + fc - 1) & fr & ":" & 列號轉(zhuǎn)字母(i + fc - 1) & first_last_row).Select.CreateNames Top:=True
????'選擇數(shù)據(jù)源區(qū)域
????Selection.CreateNames Top:=True '創(chuàng)建名稱
??Next
???
??fcount = first_list.Columns.Count
??fc_chr_last = 列號轉(zhuǎn)字母(fc + fcount - 1)
??sheet_range = fname & "!" & "$" & fc_chr & "$" & CStr(fr) & ":" & "$" & fc_chr_last & "$" & CStr(fr)
???
??Application.DisplayAlerts = False
??Set first_botton = Application.InputBox("請框選要放至一級菜單單元格/區(qū)域", Title:="提示", Type:=8)
??fnameb = SheetName(first_botton)
??num_second = Application.InputBox("請以整數(shù)形式輸入二級菜單與一級菜單之間的間隔列數(shù)，默認為1")
??If num_second = "" Then
????num_second = 1
??Else
????num_second = Int(num_second)
??End If
???
??fbc = f
