Question

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

我希望我的循环采用第一个给定的日期范围，并输出介于该日期范围之间的我范围内的所有单元格的总和。我还希望循环为形状上方的单元格加上搜索的月份。我的日期范围是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

所需的输出

当前输出

Answer 1

因此，您基本上希望每个月求和，而这样做可能是最简单的事情。我假设这只是一次时间，但是您可以查找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

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

1 个答案: