Question

我正在开发一个程序，它将多个excel工作簿编译成一个并绘制数据。我遇到的一个问题是实际数据之前的行有所不同，我希望代码能够自己找到起点。最重要的是，我希望它使用从该行开始的范围，并一直沿着电子表格继续，直到数据停止。 Data File Example

到目前为止，这是我的代码：

Private Sub runHPO_Click()
Dim FolderPath As String
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As range
Dim DestRange As range
Dim DataSheet As Worksheet
Dim cht As Chart

Application.ScreenUpdating = False

'Test specific section - directory, chart title
FolderPath = "I:\SHARED\Marshall Test Compiler\Performance Tests\3.2.1.7 HPO\"
FileName = Dir(FolderPath & "*.*")
ThisWorkbook.Charts.Add.Name = "HPO"
Set cht = ActiveChart
With cht
    .ChartType = xlXYScatterLinesNoMarkers
    .HasTitle = True
    .ChartTitle.Text = "3.2.1.7 Hot Pump Out"
    .Axes(xlCategory).HasTitle = True
    .Axes(xlCategory).AxisTitle.Text = "Time [min:sec]"
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Text = "Fan Speed [rpm]"
End With

Do While FileName <> ""
    ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = FileName
    Set DataSheet = ActiveSheet
    Set WorkBk = Workbooks.Open(FolderPath & FileName)
    Set SourceRange = WorkBk.Worksheets(1).range("A1:Z2045")
    Set DestRange = DataSheet.range("A1:Z2045")
    DestRange.Value = SourceRange.Value

    'Change legend name to serial number
    Dim LName As String
    LName = DataSheet.range("A14").Characters(8, 9).Text

    'Add plotting
    Dim profTime As range
    Dim profInSpeed As range
    Dim profSpDemand As range
    Dim profLoLimit
    Dim xrange As range
    Dim fsrange As range
    Dim pwmrange As range
    Dim btrange As range
    Dim sdrange As range

    Set profTime = ThisWorkbook.Worksheets("Profiles").range("H4:H13")
    Set profInSpeed = ThisWorkbook.Worksheets("Profiles").range("I4:I13")
    Set profSpDemand = ThisWorkbook.Worksheets("Profiles").range("J4:J13")
    Set profUpLimit = ThisWorkbook.Worksheets("Profiles").range("K4:K13")
    Set xrange = DataSheet.range("A797:A2045")
    Set fsrange = DataSheet.range("D797:D2045")
    Set pwmrange = DataSheet.range("J797:J2045")
    Set btrange = DataSheet.range("F797:F2045")
    Set sdrange = DataSheet.range("K797:K2045")

    xrange.NumberFormat = "mm:ss"
    profTime.NumberFormat = "mm:ss"

    'Profile
    With cht.SeriesCollection.NewSeries
        .Name = "Input Speed"
        .AxisGroup = xlPrimary
        .Values = profInSpeed
        .XValues = profTime
    End With
    With cht.SeriesCollection.NewSeries
        .Name = "Speed Demand"
        .AxisGroup = xlPrimary
        .Values = profSpDemand
        .XValues = profTime
    End With
    With cht.SeriesCollection.NewSeries
        .Name = "Fan Speed Upper Limit"
        .AxisGroup = xlPrimary
        .Values = profUpLimit
        .XValues = profTime
    End With

    'Fan Speed
    With cht.SeriesCollection.NewSeries
        .Name = LName & " Fan Speed"
        .AxisGroup = xlPrimary
        .Values = fsrange
        .XValues = xrange
    End With

    'PWM
    With cht.SeriesCollection.NewSeries
        .Name = LName & " PWM"
        .AxisGroup = xlSecondary
        .Values = pwmrange
        .XValues = xrange
    End With

    'Box Temp
    With cht.SeriesCollection.NewSeries
        .Name = LName & " Box Temp"
        .AxisGroup = xlSecondary
        .Values = btrange
        .XValues = xrange
    End With

    'Speed Demand
    With cht.SeriesCollection.NewSeries
        .Name = LName & " Speed Demand"
        .AxisGroup = xlSecondary
        .Values = sdrange
        .XValues = xrange
    End With

    WorkBk.Close savechanges:=False
    FileName = Dir()
Loop

With cht
    .HasAxis(xlValue, xlSecondary) = True
    .Axes(xlValue, xlSecondary).HasTitle = True
    .Axes(xlValue, xlSecondary).AxisTitle.Select
    .Axes(xlValue, xlSecondary).AxisTitle.Text = "PWM [%] / Box Temp [degC]"
    .Axes(xlValue, xlPrimary).MaximumScale = 2400
    .Axes(xlValue, xlSecondary).MaximumScale = 120
    .Axes(xlValue, xlSecondary).MinimumScale = -800
    .SeriesCollection(1).Delete
End With
ThisWorkbook.Worksheets("Compiler").Select
Application.ScreenUpdating = True
End Sub

Answer 1

在您的示例中，您的数据受到最左侧的大量标题信息的阻碍。如果总是如此，您可以选择一个永远不会有数据的列，并使用以下内容查找第一行：

FirstRow = Sheets("Your Sheet Name").Cells(1, 20).end(xlDown).Row

（这假设第20列没有所有标题数据）。您可以使用以下命令查找最后一行连续数据：

LastRow = Sheets("Your Sheet Name").Cells(FirstRow, 20).end(xlDown).Row

最后一栏：

LastColumn = Sheets("Your Sheet Name").Cells(FirstRow, Columns.Count).end(xltoLeft).Column

如果不存在无阻碍列的情况，我建议您使用.Find功能查找唯一的数字或字母格式。

VBA Excel：查找正在使用5列以上的行

1 个答案: