2017-06-15 2 views
0

Ich arbeite an einem Programm, das mehrere Excel-Arbeitsmappen in eins kompiliert und die Daten plottet. Ein Problem ist, dass die Zeilen vor den eigentlichen Daten variieren und ich möchte, dass der Code den Startpunkt selbst findet. Darüber hinaus möchte ich einen Bereich verwenden, der von dieser Zeile ausgeht und den ganzen Weg in der Tabelle fortsetzt, bis die Daten nicht mehr vorhanden sind. Data File ExampleVBA Excel: Finde Zeile, in der mehr als 5 Spalten verwendet werden

Hier ist mein Code so weit:

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 
+0

Willkommen bei SO! Im Allgemeinen ist es viel einfacher für jemanden wie mich, Ihre Frage in kleinere, diskrete Fragen zu "Wie mache ich ..." aufzuteilen. "Ich möchte, dass der Code den Startpunkt selbst findet." --- Lass uns über dieses Problem sprechen. Hast du schon von '' xlUp''' und '' 'xlDown''' gehört? Was ist mit der Verwendung von '' 'Cells (i, j)' ''? Google diese und sehen, wo es helfen könnte! –

+0

Danke, das werde ich mir merken! Ich habe ziemlich viel gegoogelt und ein paar Variationen mit denen probiert, meistens mit '.find', aber ich konnte es nicht zum Laufen bringen. Ich glaube, der genaue Code, den ich verwendet habe, war 'rowStart = DataSheet.Columns (" K "). Find (was: =" * ", After: = Zellen (" K1 "), LookIn: = xlValues, SearchDirection: = xlNext)' und 'fRow = rowStart.row'. –

Antwort

0

In Ihrem Beispiel Ihre Daten durch eine Menge von Header-Informationen am linken behindert wird. Wenn dies immer der Fall ist, können Sie eine Spalte auswählen, die nie Daten vor ihm hat und die erste Zeile finden mittels:

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

(Dies setzt voraus, dass Spalte 20 aller Kopfdaten klar). Sie können die letzte Reihe von zusammenhängenden Daten finden mittels:

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

Die letzte Spalte:

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

Wenn es nicht der Fall ist, dass es eine ungehinderte Spalte ist, empfehle ich Ihnen Verwenden Sie die Funktion .Find, um eine eindeutige Nummer oder ein Alpha-Format zu finden.

+0

Danke, Darrell! Das funktioniert großartig! –

Verwandte Themen