Function ЕдиныйФормат(Дата)
    Dim M As String, D As String
    If IsDate(Дата) Then
        M = Month(Дата): D = Day(Дата)
        ЕдиныйФормат = Year(Дата) & IIf(Len(M) = 1, 0 & M, M) & IIf(Len(D) = 1, 0 & D, D)
    Else
        ЕдиныйФормат = CVErr(xlErrValue)
    End If
End Function

Function ЕдиныйФормат2(Дата)
    If IsDate(Дата) Then ЕдиныйФормат2 = Format(Дата, "YYYYMMDD") Else ЕдиныйФормат2 = CVErr(xlErrValue)
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim objAxis As Axis
    '
    Set objAxis = Charts("Диаграмма1").Axes(xlCategory)
    If Not Intersect(Target, Range("B14")) Is Nothing Then
        objAxis.MinimumScale = Range("B14").Value
    End If
    If Not Intersect(Target, Range("B16")) Is Nothing Then
        objAxis.MaximumScale = Range("B16").Value
    End If
End Sub

Option Explicit
Option Base 1

Sub Test1()
    Dim Rng As Range
    Dim T1(), T2(), X, Y, H
    Dim XColl As New Collection, YColl As New Collection
    Dim RCnt As Long, N As Long, M As Long, J As Long, K As Long, L As Long
    '
    Set Rng = [B5]
    '
    H = Rng.Value
    Set Rng = Rng.CurrentRegion
    RCnt = Rng.Rows.Count - 1
    T1 = Rng.Offset(1).Resize(RCnt, 3).Value
    ReDim Xs(RCnt), Ys(RCnt)
    On Error Resume Next
    For K = 1 To RCnt
        XColl.Add T1(K, 1), CStr(T1(K, 1))
        YColl.Add T1(K, 2), CStr(T1(K, 2))
    Next
    On Error GoTo 0
    N = XColl.Count
    M = YColl.Count
    ReDim T2(N + 1, M + 1)
    T2(1, 1) = H
    For Each X In XColl
        L = L + 1: T2(L + 1, 1) = X
        J = 0
        For Each Y In YColl
            J = J + 1: T2(1, J + 1) = Y
            For K = 1 To RCnt
                If T1(K, 1) = X And T1(K, 2) = Y Then
                    T2(L + 1, J + 1) = T1(K, 3): Exit For
                End If
            Next
        Next
    Next
    '
    Set Rng = [W12]
    '
    With Rng.CurrentRegion
        .ClearContents
        .Resize(N + 1, M + 1).Value = T2
    End With
End Sub

Sub ReplaceItem(Key As String, NewItem, Coll As Collection)
    Const TempKey As String = "TempKey.KeyTemp.TempKey"
    With Coll
        .Add NewItem, TempKey, Key
        .Remove Key
        .Add NewItem, Key, TempKey
        .Remove TempKey
    End With
End Sub

Sub Test123()
    Dim Coll As New Collection
    With Coll
        .Add "Item1", "Key1"
        .Add "Item2", "Key2"
        .Add "Item3", "Key3"
        '
        Debug.Print "-----------"
        Debug.Print .Item("Key1")
        Debug.Print .Item("Key2")
        Debug.Print .Item("Key3")
        '
        ReplaceItem "Key2", "Item100", Coll
        '
        Debug.Print "-----------"
        Debug.Print .Item("Key1")
        Debug.Print .Item("Key2")
        Debug.Print .Item("Key3")
    End With
End Sub