zoeken in rij naar laatste cel met gegevens

[joskjos]

Hallo,

Ik ben op zoek naar een macro die het volgende zou kunnen:
In rij 3 staan gegevens tot en met kolom Z.
Per rij kan het verschillen tot hoe ver deze is gevuld met gegevens dus het kan ook zijn dat de gegevens stoppen van bijv. rij 4 bij kolom O.

Ik zou dan graag willen met een macro dat de laatste 10 gevulde cellen van een rij gekopieerd worden naar tabel uitkomst 1 kolom AC t/m AL.
In tabel uitkomst 2 zou ik dan ook met een macro de uitkomst willen laten verschijnen.

Bijgevoegd een voorbeeld bestand met opmerkingen. Hopelijk is het duidelijk genoeg.

Gr,
Jos

Voorbeeld bestand: Bekijk bijlage zoeken laatst gevulde cel in rij.xlsm

 

[VenA]

Ik denk dat je het een beetje beter moet uitleggen.

<-- De bedoeling is dat de laatste 10 gevonden cellen met gegevens in de rij gekopieerd worden behalve de eerste 10 gevonden cellen

strookt niet met het voorbeeldbestand. Is tabel1 een tijdelijke tabel om de stappen duidelijk te maken? Is tabel2 het gewenste resultaat? En is tabel1 eigenlijk niet nodig? Waarom moet er gezocht worden op de waarden die in kolom F staat? Kolom F is de zesde kolom en mag toch niet meedoen? Of is 'Gegevens 6' variabel en kan in elke kolom staan?

En zo kan ik nog wel wat vragen stellen.

 

[HSV]

Ik doe een poging.
Resultaat op blad2.

Sub hsv()
Dim sn, i as long, lc As Long
With Sheets("blad1")
sn = .Cells(2, 1).CurrentRegion
 For i = 3 To UBound(sn)
   lc = .Cells(i, Columns.Count).End(xlToLeft).Column
   If lc > 10 Then
   If InStr(Join(Application.Index(sn, i, Array(lc - 9, lc - 8, lc - 7, lc - 6, lc - 5, lc - 4, lc - 3, lc - 2, lc - 1, lc))), "Gegevens 6") Then
    Sheets("blad2").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 11) = Split(i - 2 & "|" & Join(Application.Index(sn, i, Array(lc - 9, lc - 8, lc - 7, lc - 6, lc - 5, lc - 4, lc - 3, lc - 2, lc - 1, lc)), "|"), "|")
   End If
   End If
  lc = 0
 Next i
End With
End Sub

Edit: incl. nummers

 

[joskjos]

@VenA, De eerst 10 cellen mogen in de rij nooit gekopieerd worden. Alle gegevens in de rij zijn variabel. Bevat een rij alleen maar gegevens in de eerste 10 cellen van de rij dan hoeft er niets gekopieerd te worden. Bevat een rij 25 gevulde variabele gegevens dan alleen de laatste 10 cellen kopiëren naar bijvoorbeeld blad 2 rij 1. Dit dan voor elke rij apart uitvoeren.


@HSV, het is niet helemaal wat ik bedoel. Iedergeval al erg bedankt voor het meedenken

 

[HSV]

Volgens mij is het conform de omschrijving.
Het resultaat is alleen de tweede tabel.

 

[joskjos]

@HSV

Ik ben er al achter waar het foutje zat.
Ik heb "Gegevens 6" in de code weggehaald en dan komt het resultaat er wat ik bedoel!

Het enige wat nog niet werkt is dat dan de cellen worden geknipt en geplakt. Nu wordt het gekopieerd en geplakt is dit ook nog mogelijk? (op blad 1 zijn de 10 laatste cellen in een rij dan niet meer te zien)

Al super werk geleverd ben nu al!

Gr,
Jos

 

[HSV]

Maak eens een bestand met de werkelijke gegevens zodat ik een code kan bedenken die daar bij past.

 

[VenA]

Met wat aanpassingen in de code van HSV kom ik op deze uit.

Sub hsv()
Dim sn, i, sq, lc As Long
With Sheets("blad1")
sn = .Cells(2, 1).CurrentRegion
    For i = 3 To UBound(sn)
        lc = .Cells(i, Columns.Count).End(xlToLeft).Column
        If lc > 10 Then
            With Sheets("blad2")
                .Cells(i - 1, 1).Resize(, 11) = Split(i - 2 & "|" & Join(Application.Index(sn, i, Array(lc - 9, lc - 8, lc - 7, lc - 6, lc - 5, lc - 4, lc - 3, lc - 2, lc - 1, lc)), "|"), "|")
                If InStr(Join(Application.Index(sn, i, Array(lc - 9, lc - 8, lc - 7, lc - 6, lc - 5, lc - 4, lc - 3, lc - 2, lc - 1, lc))), "Gegevens 6") Then
                    .Cells(Rows.Count, 13).End(xlUp).Offset(1).Resize(, 11) = Split(i - 2 & "|" & Join(Application.Index(sn, i, Array(lc - 9, lc - 8, lc - 7, lc - 6, lc - 5, lc - 4, lc - 3, lc - 2, lc - 1, lc)), "|"), "|")
                End If
                .Columns.AutoFit
            End With
            .Cells(i, lc).Offset(, -9).Resize(, 10).ClearContents
        End If
    Next i
End With
End Sub

Zowel uitkomst 1 als uitkomst 2 komen op blad2. Ook worden de gekopieerde gegevens gewist.

 

[HSV]

@HSV

Ik ben er al achter waar het foutje zat.
Ik heb "Gegevens 6" in de code weggehaald en dan komt het resultaat er wat ik bedoel!

Gr,
Jos

Ik heb zo een vermoeden dat het nog niet helemaal goed is als ik bovenstaande lees (daarom vroeg ik om een juiste bestand te plaatsen), maar goed,....... ik zou de 'autofit' in ieder geval een beetje verder naar onderen plaatsen.

Sub hsv()
Dim sn, i, sq, lc As Long
With Sheets("blad1")
sn = .Cells(2, 1).CurrentRegion
    For i = 3 To UBound(sn)
   lc = UBound(Split(Replace(Join(Application.Index(sn, i, 0), "|"), "||", "") & "|"))
     '   lc = .Cells(i, Columns.Count).End(xlToLeft).Column
        If lc > 10 Then
            With Sheets("blad2")
                .Cells(i - 1, 1).Resize(, 11) = Split(i - 2 & "|" & Join(Application.Index(sn, i, Array(lc - 9, lc - 8, lc - 7, lc - 6, lc - 5, lc - 4, lc - 3, lc - 2, lc - 1, lc)), "|"), "|")
                If InStr(Join(Application.Index(sn, i, Array(lc - 9, lc - 8, lc - 7, lc - 6, lc - 5, lc - 4, lc - 3, lc - 2, lc - 1, lc))), "Gegevens 6") Then
                    .Cells(Rows.Count, 13).End(xlUp).Offset(1).Resize(, 11) = Split(i - 2 & "|" & Join(Application.Index(sn, i, Array(lc - 9, lc - 8, lc - 7, lc - 6, lc - 5, lc - 4, lc - 3, lc - 2, lc - 1, lc)), "|"), "|")
                End If
             End With
          .Cells(i, lc).Offset(, -9).Resize(, 10).ClearContents
        End If
    Next i
End With
Sheets("Blad2").Columns.AutoFit
End Sub

 

[joskjos]

Ik ben toch ook zelf bezig geweest met een andere zoekmanier.

Ik heb de volgende code samengesteld deze werkt ook goed maar als er in de cel waar de criteria staat een joker teken * staat pakt hij dit niet.
Het kan namelijk voorkomen dat in 1 cel 2 woorden staan terwijl ik 1 van de woorden weet waarop gezocht wordt.
Iemand een suggestie hoe de code te veranderen?

Sub zoeken()
Dim cell As Range
For Each cell In Worksheets("Formule").Range("F16:F250").Cells
If cell.Value = Sheets("zoeken").Range("B2") Then  'in cell B2 staat het zoekwoord, nu wil ik achter het zoekwoord * zodat bij meerdere woorden in cell deze ook gevonden wordt'
cell.Columns("A:Q").Copy
With Sheets("uitkomst")
.Range("F" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
End With
cell.EntireRow.Clear
End If
Next cell
End Sub

Ps: De andere code kom ik nog op terug ik ben die nog aan het uittesten in een bestand waarin ik hem invoeg.