Macro laten zoeken na cellen waar vervolg bewerking plaats vind

[Relleboer]

ik heb een bestand dat om de kolom een waarde heeft staan. hoe kan ik zorgen dat de macro hem steeds herkent zodat ik van die punten steeds een bewerking kan laten plaatsvinden. Het komt erop neer dat ik elke keer een verschillende hoeveelheid aan data hebt en hem op regel 1 wil laten zoeken naar een gevulde cel en daar een een bewerking wil laten plaats vinden en dat de macro daarna de volgende gevulde cel vind tot hij geen gevulde cellen meer vind op rij 1.

groeten Jan-willem

 

[Wigi]

Hoi

Dat kan heel handig met de SpecialCells eigenschap in VBA. Zie help files. Laat een Range variabele door de gevonden "loopen" en telkens de bewerking uitvoeren.

Wigi

 

[Relleboer]

Helaas Wim,

Ik heb geprobeerd maar zou niet weten hoe ik hem moet loopen door rij 1. kun je me nog een klein stukje verder opweg helpen aub.

Jan-wilem

 

[Relleboer]

Ik heb even bestandje bijgevoegt. Het gaat erom dat hij een grafiek geeft met de gevonden gegevens. De gegevens haalt hij uit alle files in de aangegeven werkmap. Het kunnen er dus veel of weinig zijn dat verschilt. Nu wil ik graag dat hij dus van elk blok een lijn geeft in dezelfde grafiek.

groet jan-willem

 

[Jarcol]

Helaas Wim,

Ik heb geprobeerd maar zou niet weten hoe ik hem moet loopen door rij 1. kun je me nog een klein stukje verder opweg helpen aub.

Jan-wilem

Kan zoiets niet?

Do
Range("A1").Select

	If ActiveCell.Value <> ""
	'doe je actie
	ActiveCell.Ofsset(1,0).Select
	End If
	
Loop Until ActiveCell.Range(IV1).select

 

[Relleboer]

Dit werkt helaas niet. Misschien een andre oplossing of iemand anders die me kan helpen??????????

 

[Relleboer]

Wigi kun jij me misschien verder helpen?

 

[Relleboer]

Sub grafieken()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next

Set wbCodeBook = ThisWorkbook

    With Application.FileSearch
        .NewSearch
         'bestands adres wijzegen na de goede
        .LookIn = "C:\Documents and Settings\Lab\Mijn documenten\Data voor grafieken"
        .FileType = msoFileTypeExcelWorkbooks
        .Filename = "*.csv"
        
            If .Execute > 0 Then 'wekboeken in folder
                For lCount = 1 To .FoundFiles.Count 'Loop door alle mappen.
                 'Open Workbook x and Set a Workbook variable to it
                 Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)
                                  
                  NumberFormat = "0.00"
        Range("L2").FormulaR1C1 = "=RC[-11]-R2C1"
    With Range("L2")
        .Copy
        .AutoFill Range(.Cells(1), .Offset(, -1).End(xlDown).Offset(, 1))
    End With
        Range("M2").FormulaR1C1 = "=RC[-9]/1000"
    With Range("m2")
        .Copy
        .AutoFill Range(.Cells(1), .Offset(, -1).End(xlDown).Offset(, 1))
    End With
        Range("m1").Value = Worksheets(1).Name
        Columns("L:M").Copy
        Windows("Graphics jules.xls").Activate
        Columns("A:b").Select
        Selection.Insert Shift:=xlToRight
        Range("a1").PasteSpecial (xlPasteValues)
        Range("a1").Select
                 wbResults.Close SaveChanges:=False
                 
                 Next lCount
            End If
    End With
   
    
    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    lijnentoevoegen
    grafiekbewerken
End Sub

Sub grafiekbewerken()
    Charts("O2 (ppm) vs Time (days) graphic").Select
    With ActiveChart
        
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time (Days)"
        .Axes(xlCategory, xlPrimary).AxisTitle.Font.Name = "Arial"
        .Axes(xlCategory, xlPrimary).AxisTitle.Font.FontStyle = "Vet"
        .Axes(xlCategory, xlPrimary).AxisTitle.Font.Size = 16
        .Axes(xlCategory, xlPrimary).TickLabels.Font.Size = 16
        .Axes(xlCategory, xlPrimary).TickLabels.Font.Name = "ariel"
        .Axes(xlCategory, xlPrimary).TickLabels.Font.FontStyle = "vet"
        .Axes(xlCategory, xlPrimary).Border.Weight = xlThick
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "O2 (ppm)"
        .Axes(xlValue, xlPrimary).AxisTitle.Font.Name = "Ariel"
        .Axes(xlValue, xlPrimary).AxisTitle.Font.FontStyle = "Vet"
        .Axes(xlValue, xlPrimary).AxisTitle.Font.Size = 16
        .Axes(xlValue, xlPrimary).Border.Weight = xlThick
        .Axes(xlValue, xlPrimary).TickLabels.Font.Size = 16
        .Axes(xlValue, xlPrimary).TickLabels.Font.Name = "ariel"
        .Axes(xlValue, xlPrimary).TickLabels.Font.FontStyle = "vet"
        

        For d = 1 To .SeriesCollection.Count
        .SeriesCollection(d).Border.Weight = xlThick
        Next
    End With
    With ActiveChart.Legend
        For i = 1 To .LegendEntries.Count
        .LegendEntries(i).Font.Name = "Arial"
        .LegendEntries(i).Font.FontStyle = "Vet"
        Next
    End With
       
End Sub

Sub lijnentoevoegen()
    Dim itemnummer As Integer
    itemnummer = 2
    Charts.Add
    ActiveChart.ChartType = xlXYScatterSmooth
    ActiveChart.Name = "O2 (ppm) vs Time (days) graphic"
    Sheets("main").Select
   Do
    Cells(1, itemnummer).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.Offset(0, -1)).Select
    Charts("O2 (ppm) vs Time (days) graphic").SeriesCollection.Add Source:=Selection
    itemnummer = itemnummer + 2
    Loop Until Cells(1, itemnummer).Value = Empty
End Sub

alle handelingen werken nu via de volgende code

 

[Wigi]

Bedankt om het te posten.

Probeer wel de Select zoveel mogelijk te mijden.

Ipv.

Cells(1, itemnummer).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.Offset(0, -1)).Select
    Charts("O2 (ppm) vs Time (days) graphic").SeriesCollection.Add Source:=Selection

zal meer dan waarschijnlijk dit ook werken:

    Dim r As Range
    
    Set r = Range(Cells(1, itemnummer), Cells(1, itemnummer).End(xlDown)).Offset(0, -1)
    
    Charts("O2 (ppm) vs Time (days) graphic").SeriesCollection.Add Source:=r

Wigi