在X轴上设置日期

Eri*_*man 0 excel vba excel-vba

我正在尝试在Excel VBA中创建一个图表,并且在让X轴正确显示日期方面遇到了问题.代码如下:

Function CreateChart()
Dim objChart As Chart

ReDim detached_price(detachedProps.count - 1) As Double
ReDim detached_date(detachedProps.count - 1) As Date

ReDim semi_price(semiProps.count - 1) As Double
ReDim semi_date(semiProps.count - 1) As Date

Dim minDate As Date
Dim maxDate As Date
minDate = Date

Dim detachedCount As Integer
detachedCount = 0
Dim semiCount As Integer
semiCount = 0

Set objChart = Charts.Add
With objChart
    .HasTitle = True
    .ChartTitle.Characters.Text = "Price Paid"
    .ChartType = xlXYScatter
    .Location xlLocationAsNewSheet
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date"
    .Axes(xlCategory, xlPrimary).CategoryType = xlTimeScale
    .Axes(xlCategory, xlPrimary).TickLabels.NumberFormat = "yyyy"
    .Axes(xlCategory, xlPrimary).MinimumScaleIsAuto = True
    .Axes(xlCategory, xlPrimary).MaximumScaleIsAuto = True

    For Each prop In properties
        Select Case prop.PropertyType
            Case "Detached"
                detached_price(detachedCount) = prop.Amount
                detached_date(detachedCount) = prop.SellDate
                detachedCount = detachedCount + 1
            Case "Semi-detached"
                semi_price(semiCount) = prop.Amount
                semi_date(semiCount) = prop.SellDate
                semiCount = semiCount + 1
        End Select

        If prop.SellDate < minDate Then
            minDate = prop.SellDate
        End If

        If prop.SellDate > maxDate Then
            maxDate = prop.SellDate
        End If
    Next

    .SeriesCollection.NewSeries

    .SeriesCollection(DETACHED).Name = "Detached"
    .SeriesCollection(DETACHED).Values = detached_price
    .SeriesCollection(DETACHED).XValues = detached_date

    .SeriesCollection.NewSeries
    .SeriesCollection(SEMI).Name = "Semi-Detached"
    .SeriesCollection(SEMI).Values = semi_price
    .SeriesCollection(SEMI).XValues = semi_date
End With End Function
Run Code Online (Sandbox Code Playgroud)

填充For..Each循环中的属性变量,并正确填充数组.

但是,尽管显示了散点图数据点,但轴上的日期均显示为1900.

我尝试添加这些行:

    .Axes(xlCategory, xlPrimary).MinimumScale = CDbl(minDate)
    .Axes(xlCategory, xlPrimary).MaximumScale = CDbl(maxDate)
Run Code Online (Sandbox Code Playgroud)

其中显示了沿轴的正确年份,但现在两个系列的所有数据点都消失了.

我已经尝试过其他一些东西,但它纯粹基于试错法.

数据如下

数据如下:

结果图表是:

正确的日期,没有数据点

正确的日期,没有数据点

日期不正确,但我们有数据点

日期不正确,但我们有数据点

Coo*_*lue 5

即使我不同意他们对"常见"日期格式的定义:q,我认为@chiliNUT正在做些什么.强制日期格式似乎存在一些问题.

如果您将所有Date类型变量更改为DoubleLong,它应该可以工作.

例如改变

ReDim detached_date(detachedProps.count - 1) As Date
Run Code Online (Sandbox Code Playgroud)

ReDim detached_date(detachedProps.count - 1) As Double
Run Code Online (Sandbox Code Playgroud)

要么

ReDim detached_date(detachedProps.count - 1) As Long
Run Code Online (Sandbox Code Playgroud)

这样,日期不会StringXValues方法转换.它们存储为日期序列号,轴程序能够将它们成功强制转换为本地日期格式.

什么在你的代码发生的事情是在Date类型强制转换成StringXValues方法和轴渲染程序似乎是无法强迫他们回到正确的日期.

我不认为它实际上与国际设置有关,因为我尝试使用这样的日期:

1/01/2013
1/01/2014
1/01/2015
1/01/2016
1/01/2017
1/01/2018
1/01/2019
1/01/2020
1/01/2021
Run Code Online (Sandbox Code Playgroud)

适用于任何一种系统.

我认为它只是轴渲染例程中的一个错误,它无法正确地将字符串强制转换为日期.

我很想听听比我更有知识的人.

另外,我很好奇这个:

.SeriesCollection.NewSeries

.SeriesCollection(DETACHED).Name = "Detached"
.SeriesCollection(DETACHED).Values = detached_price
.SeriesCollection(DETACHED).XValues = detached_date
Run Code Online (Sandbox Code Playgroud)

它如何知道要引用哪个系列?DETACHED是否是您在别处定义的常量?

我认为这会更好:

with objChart.SeriesCollection.NewSeries
    .Name = "Detached"
    .Values = detached_price
    .XValues = detached_date
end with
Run Code Online (Sandbox Code Playgroud)