在已定義的動態命名范圍內，將動態命名范圍的標頭定義為.Name。

Question

我具有從.Cells(108,2)到該范圍中的最后一個Cell的動態命名范圍'HDaERReturns'，我想將其切成.Cells(108,2)列，並用其在第106行中保留的標題命名每列。

Range的當前方式示例：

|    Item    |   EURUSD   |   GBPUSD   |   USDCHF   |   XAUUSD   |
|:----------:|:----------:|:----------:|:----------:|:----------:|
|    Date    | Volatility | Volatility | Volatility | Volatility |
| 06.03.2018 |            |            |            |            |
| 05.03.2018 |            |            |            |            |
| 04.03.2018 |            |            |            |            |
| 02.03.2018 |            |            |            |            |
| 01.03.2018 |            |            |            |            |
| 28.02.2018 |            |            |            |            |
| 27.02.2018 |            |            |            |            |
| 26.02.2018 |            |            |            |            |
| 25.02.2018 |            |            |            |            |

我需要為動態命名范圍“ HDaERReturns”中的每一列命名，因為：

1. 我需要遍歷動態命名范圍“ HDaERReturns”中每一列中的每個單元格，並在其中執行常規對數返回計算，這是指另一個動態命名范圍“ HDaERClose”，我必須將其切成列並用頭。 這樣，我可以通過編碼類似以下內容來引用計算階段：

   For Each Column In Range("HDaERReturns") ' Set header as .Name Next

   For Each Cell In Columns ' Perform calculations Next

並得到這樣的輸出：

2. 在代碼的稍后階段，我需要運行多元回歸分析並排除每個P值> 0.15的數組（請參閱此問題）。 為了排除相關值（P值）無法滿足的數組，我需要將列標題作為列DNR的名稱。

我還沒有進入MLR階段，所以我沒有正確糾正問題，但這是一個不同的話題。 現在，我需要創建帶有標題的列動態命名范圍。

標頭不斷變化，它們對應的列中的值也不斷變化，因此它必須是一種動態方法。

到目前為止，還沒有真正有意義的代碼，但是我想知道是否有人可以為我提供一些有關如何解決此問題的指導。

Answer 1

這是為您的命名范圍創建。

注意：

1. 我使用您的日期列來設置每個動態范圍的高度，以防列中數據丟失（假設日期列是最完整的）。
2. 我假設您的日期列實際上是文本，所以使用COUNTA 。 否則，將COUNTA替換為COUNT 。

版本1這將創建動態的命名范圍，但是如果您在列中缺少數據，則可能會導致問題。

Option Explicit

Public Sub PerformLogOperation()

    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet

    Set wbTarget = ThisWorkbook
    Set wsTarget = wbTarget.Worksheets("Sheet1")

    Dim namedRange As Range
    Dim namesArr()

    Set namedRange = wsTarget.Range("HDaERReturns")

    namesArr = GetNamedRangeNames(namedRange)

    CreateNamedRanges namedRange, namesArr

    ''TODO Your log operation code goes here

End Sub

Public Sub CreateNamedRanges(ByVal namedRange As Range, ByVal namesArr As Variant, Optional wbTarget As Workbook)

    Dim currentNamedRange As Long
    Dim tempRange As Range
    Dim tempRangeName As String

    If wbTarget Is Nothing Then Set wbTarget = ThisWorkbook

    Dim sheetName As String
    sheetName = namedRange.Parent.Name
    Dim startRow As Long
    Dim endRow As Long
    Dim columnForCount

    startRow = namedRange.Row + 2
    endRow = namedRange.Parent.Cells.Rows.Count
    columnForCount = namedRange.Column

    For currentNamedRange = LBound(namesArr, 2) To UBound(namesArr, 2)

        With namedRange

           Set tempRange = .Columns(currentNamedRange + 1).Offset(2, 0).Resize(.Rows.Count - 2, 1)

        End With

        tempRangeName = Trim$(namesArr(1, currentNamedRange))

        wbTarget.Names.Add Name:=tempRangeName, _
        RefersTo:="=OFFSET(" & sheetName & "!R" & startRow & "C" & columnForCount + currentNamedRange & _
                  ",0,0,COUNTA(" & sheetName & "!R" & startRow & "C" & columnForCount & ":R" & endRow & "C" & _
                  columnForCount & "),1)"

        Set tempRange = Nothing
        tempRangeName = vbNullString

    Next currentNamedRange

End Sub

Public Function GetNamedRangeNames(ByVal namedRange As Range) As Variant

    Dim namesArr()

    With namedRange.Rows(1)

        namesArr = .Offset(, 1).Resize(1, .Columns.Count - 1).Value2

    End With

    GetNamedRangeNames = namesArr

End Function

版本2固定長度

Option Explicit

Public Sub CreateNamedRanges2(ByVal namedRange As Range, ByVal namesArr As Variant, Optional wbTarget As Workbook)

    Dim currentNamedRange As Long
    Dim tempRange As Range
    Dim tempRangeName As String

    If wbTarget Is Nothing Then Set wbTarget = ThisWorkbook

    For currentNamedRange = LBound(namesArr, 2) To UBound(namesArr, 2)

        With namedRange

           Set tempRange = .Columns(currentNamedRange + 1).Offset(2, 0).Resize(.Rows.Count - 2, 1)

        End With

        tempRangeName = Trim$(namesArr(1, currentNamedRange))

        wbTarget.Names.Add Name:=tempRangeName, RefersTo:=tempRange

        Set tempRange = Nothing
        tempRangeName = vbNullString

    Next currentNamedRange

End Sub