时间戳

首页 > 解决方案 > 当变量等于新月时如何创建新形状

excel - 当变量等于新月时如何创建新形状

问题描述

我目前有一个循环来检查一个范围内的单元格是否落在两个日期之间。我的循环当前为给定日期范围之间的每个单元格创建一个新形状。

我希望我的循环采用第一个给定的日期范围并输出我的范围内落在日期范围之间的所有单元格的总和。我还希望循环用它搜索的月份来命名形状上方的单元格。我的日期范围是startDate和endDate 代码

Sub foo()
Dim oval As Shape
Dim rCell As Range
Dim rng As Range
Dim h As Integer
Dim w As Integer
Dim x As Long
Dim shp As Object
Dim counter As Long
Dim startDate As Date, endDate As Date
Set rng = Sheet1.Range("A1:B6")


h = 495
startDate = "01/01/2019"
endDate = "03/10/2019"

For Each rCell In rng
    If IsDate(rCell.Value) Then
        If rCell.Value >= startDate And rCell.Value <= endDate Then

            counter = counter + 1

            Set oval = ActiveSheet.Shapes.AddShape(msoShapeOval, h + 70 * (counter - 1), w + 125, 60, 65)

            With oval
                .Line.Visible = True
                .Line.Weight = 2
                .Fill.ForeColor.RGB = RGB(255, 255, 255)
                .Line.ForeColor.RGB = RGB(0, 0, 0)
                .TextFrame.Characters.Caption = rCell.Value
                .TextFrame.HorizontalAlignment = xlHAlignCenter
                .TextFrame.VerticalAlignment = xlVAlignCenter
                .TextFrame.Characters.Font.Size = 12
                .TextFrame.Characters.Font.Bold = True
                .TextFrame.Characters.Font.Color = RGB(0, 0, 0)
            End With
        End If
    End If
Next rCell

End Sub

期望的输出 在此处输入图像描述

电流输出 在此处输入图像描述

标签： excelvba

解决方案

因此，您基本上想按一个月求和，而要做到这一点，数组可能是最简单的事情。我假设它只有一年，但您可以查找 Redim Preserver 进行更改。

这是递增设置范围内的每个值并将其添加到对应于月份数的数组中。

 Sub BoOm()
Dim YourSTuff(1 To 12, 0 To 0) As Long, aCell As Range, YourRNG As Range, startDate As Date, endDate As Date

Set YourRNG = Range("A1:B99")

startDate = "01/01/2019"
endDate = "03/10/2019"


For Each aCell In YourRNG.Cells
    If IsDate(aCell.Value) Then
        If aCell.Value >= startDate And aCell.Value <= endDate Then
            YourSTuff(Month(aCell), 0) = YourSTuff(Month(aCell), 0) + 1
        End If
    End If
Next aCell


'when you're done.
Dim i As Long, c As Long
c = 1
    For i = LBound(YourSTuff) To UBound(YourSTuff)
        If YourSTuff(i, 0) > 0 Then


                Set Oval = ActiveSheet.Shapes.AddShape(msoShapeOval, h + 70 * (c), w + 125, 60, 65)
                c = c + 1

                With Oval
                    'not sure how to format as you want
                    .Line.Visible = True
                    .Line.Weight = 2
                    .Fill.ForeColor.RGB = RGB(255, 255, 255)
                    .Line.ForeColor.RGB = RGB(0, 0, 0)
                    .TextFrame.Characters.Caption = Choose(i, "January", "February", "March", "April", "May", "June", "" & _
                     "July", "August", "September", "October", "November", "December") & Chr(10) & YourSTuff(i, 0)
                    .TextFrame.HorizontalAlignment = xlHAlignCenter
                    .TextFrame.VerticalAlignment = xlVAlignCenter
                    .TextFrame.Characters.Font.Size = 12
                    .TextFrame.Characters.Font.Bold = True
                    .TextFrame.Characters.Font.Color = RGB(0, 0, 0)
                End With
        End If


    Next i


End Sub

推荐阅读