Excel的VBA宏我要尋找一個簡單的宏創建動態命名範圍表採用這種設計的動態命名範圍

Question

：

 A  B 
4 Title1 Title2 
5 val_1 val_a 
6 val_2 val_b 
7 val_3 val_3 

的要求是：

1. 名稱的動態命名範圍應該等於標題（在本例中爲「Title1」，「Title2」）。

2. 一個應該能夠指定在其行頭位於（例如第4行）。

（我已經找到了兩個這樣的宏（1，2），但他們都對第二個要求的錯誤。）

Answer 1

這裏的羅傑Govier的代碼破解版本

Sub CreateNames() 
    Dim wb      As Workbook 
    Dim ws      As Worksheet 
    Dim rStartCell    As Range 
    Dim rData     As Range 
    Dim rCol     As Range 
    Dim LastCol    As Long 
    Dim lCol     As Long 
    Dim sSheet     As String 
    Dim Rowno     As Long 

    ' get table location 
    On Error Resume Next 
    Set rStartCell = Application.InputBox(prompt:="Select top left cell of table", Title:="Select first cell", Default:=ActiveCell, Type:=8) 
    On Error GoTo err_handle 
    If rStartCell Is Nothing Then Exit Sub 

    Set ws = rStartCell.Worksheet 
    Set wb = ws.Parent 
    sSheet = "'" & ws.Name & "'" 
    With rStartCell 
     Rowno = .Row 
     Set rData = .CurrentRegion 
    End With 

    ' get column count 
    With rData 
     LastCol = .Column + .Columns.Count - 1 
    End With 
    ' reset data range 
    Set rData = ws.Range(rStartCell, ws.Cells(Rowno, LastCol)) 

    For Each rCol In rData.Columns 

     lCol = rCol.Column 
     wb.Names.Add Name:=Replace(rCol.Cells(1).Value, " ", "_"), _ 
        RefersToR1C1:="=" & sSheet & "!" & rCol.Cells(1).Address(ReferenceStyle:=xlR1C1) & ":INDEX(C" & lCol & ",LOOKUP(2,1/(C" & lCol & "<>""""),ROW(C" & lCol & ")))" 

    Next rCol 

    MsgBox "All dynamic Named ranges have been created" 
    Exit Sub 

err_handle: 

    MsgBox "Error " & Err.Number & " (" & Err.Description & _ 
      ") in procedure CreateNames" 

End Sub