VBA查找方法设置的字符串范围不正确

时间:2018-11-11 04:32:57

标签: excel vba

我在VBA循环中收到错误的日期值。我正在使用的代码如下。我有一张开始日期和结束日期的表格,其中一些是以2开头的2月日期。对于表中所有以“ 02”开头的日期,我将接收以“ 12”开头的字符串值,其余日期相同。看来数据类型或其他方面可能有错误。我如何按原样定义日期,以便我可以返回准确的日期,因为它们写在工作表的单元格中?谢谢!

Dim aa As Integer
Dim StartDate As String
Dim EndDate As String
Dim RngStart As Range
Dim RngEnd  As Range
Dim RngStartR As String
Dim RngStartRng As Range
Dim RngEndR As String
Dim RngEndRng As Range
Dim RngXR As String:  RngXR 
ActiveWorkbook.Sheets("ActiveSheet").Range("C7").value
Dim RngXR2 As String:           RngXR2 = 
ActiveWorkbook.Sheets("ActiveSheet").Range("C8").value
Dim sh As Worksheet
Dim chrt As ChartObject
Dim ch As Chart
Dim zz As Integer
Dim NumObs2 As Long

NumObs2 = Sheets("AllDistanceMeasures").Cells(Rows.Count, 10).End(xlUp).Row

For aa = 5 To NumObs2

StartDate = Sheets("AllDistanceMeasures").Cells(aa, 9).value
EndDate = Sheets("AllDistanceMeasures").Cells(aa, 10).value

    If StartDate <> "" Then

        Set RngStart = Sheets("ActiveSheet").Cells.Find(What:=StartDate, 
After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Offset(0, 1)

    Else
        MsgBox "StartDate variable for " & 
Sheets("AllDistanceMeasures").Cells(aa, 9).Address & " not found", 
vbExclamation
        Exit Sub

    End If

    RngStartR = RngStart.Address

    If EndDate <> "" Then

        Set RngEnd = Sheets("ActiveSheet").Cells.Find(What:=EndDate, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Offset(0, 1)

    Else
        MsgBox "EndDate variable for " & Sheets("AllDistanceMeasures").Cells(aa, 10).Address & " not found", vbExclamation
        Exit Sub

    End If

    RngEndR = RngEnd.Address

ActiveWorkbook.Sheets("LowDistCharts").Activate

Set sh = Worksheets("LowDistCharts")
Set chrt = sh.ChartObjects.Add(0, 0, 300, 300)
Set ch = chrt.Chart

Do While ch.SeriesCollection.Count > 1

    ch.SeriesCollection(1).Delete

Loop

    With chrt
        .Height = 300
        .Width = 300
        .Top = 1 + ((aa - 4) * 300)
        .Left = 1
    End With

    With ch
        .HasTitle = True
        .ChartTitle.Text = aa & " " & StartDate & " to " & EndDate
        .ChartTitle.Font.Size = 8
        .ChartType = xlLine
        .SeriesCollection.NewSeries
        .SeriesCollection(1).Values = ActiveWorkbook.Worksheets("ActiveSheet").Range(RngXR, RngXR2)
        .SeriesCollection.NewSeries
        .SeriesCollection(2).Values = ActiveWorkbook.Worksheets("ActiveSheet").Range(RngStartR, RngEndR)
        .SeriesCollection(2).AxisGroup = 2
        .SeriesCollection(3).Delete
        .HasLegend = False
    End With

    For zz = 0 To NumObs - 1

        Sheets("ActiveSheet").Range(RngEndR).Offset(zz, 0).Copy
        Sheets("LowDistCharts").Cells(5, aa + 5).Offset(zz, 0).PasteSpecial xlPasteValues

    Next zz

Next aa

0 个答案:

没有答案