Toon cellen waarvan een bijbehorende cel leeg is

[Leotaxi]

Roeland,

die offset terug naar (0,1) en (0,2) zetten hij moet toch kijken in 1 kolom ernaast en 2 kolommen ernaast of er een prijs ontbreekt ?

mvg

Leo

 

[Roeland035]

Roeland,

die offset terug naar (0,1) en (0,2) zetten hij moet toch kijken in 1 kolom ernaast en 2 kolommen ernaast of er een prijs ontbreekt ?

mvg

Leo

Dat voorbeeld is niet zoals het is in de echte situatie.

In de echter situatie heb ik een "uitvoer" blad met in kolom A alle artikelnummers en in kolom AT & AU de prijs informatie. (Dit komt overeen met kolom 44 en 45)
Vervolgens heb ik in het blad "Import prijslijst" enorm veel prijsinformatie staan waar met verticaal zoeken de juiste prijs uit gehaald wordt.

In ditzelfde werkblad (import prijslijst) heb ik ook het tabel staan met de missende prijsgegevens, en daar wil ik wel graag de gegevens naast elkaar printen.

Ik wil dus dat deze macro gaat kijken in het blad "uitvoer" naar de artikelnummers waar de prijsinformatie ontbreekt of gedeeltelijk ontbreekt, door te kijken of één van deze cellen leeg is.
Indien dat zo is moeten deze artikelnummers incl. de gedeeltelijke prijsinformatie geprint worden naast elkaar in het blad "import prijslijst".

 

[Leotaxi]

mij goed via skype te bereiken : leotaxi007

 

[Leotaxi]

Roeland,

toch nog 1 poging voor ik naar die arbeid ga,
kijk eens of de situatie juist is zo


mvg
Leo

 

[Roeland035]

Roeland,

toch nog 1 poging voor ik naar die arbeid ga,
kijk eens of de situatie juist is zo


mvg
Leo

Beste Leo,

Ik heb zelf ook even geknutseld en heb het werkende gekregen met de volgende macro:

        Sheets("Uitvoer").Select
        lastrow = Columns("AT:AU").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
        For i = 4 To lastrow
          If Cells(i, 46) = "" Or Cells(i, 47) = "" Then
            Cells(i, 1).Copy
                Sheets("Import prijslijst").Select
                    lastrow2 = Range("E" & Rows.Count).End(xlUp).Row + 1
                    ActiveSheet.Range("E" & lastrow2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
                Sheets("Uitvoer").Select
                
                    Cells(i, 46).Copy
                        Sheets("Import prijslijst").Select
                            ActiveSheet.Range("E" & lastrow2).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                        Sheets("Uitvoer").Select
                        
                            Cells(i, 47).Copy
                                Sheets("Import prijslijst").Select
                                    ActiveSheet.Range("E" & lastrow2).Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                        :=False, Transpose:=False
                                Sheets("Uitvoer").Select
            End If
        Next

Hij is wel een stuk langer, dus ik zal uw code ook proberen.

 

[snb]

Sub M_snb()
   With Sheets("uitvoer").Columns(47).Resize(UsedRange.Rows.Count)
      .AutoFilter 1, ""
      .Offset(1, -1).Copy Sheets("import prijslijst").Cells(Rows.Count, 1).End(xlUp).Offset(1)
      .AutoFilter
   End With
End Sub

 

[Roeland035]

Beste Leo,

Het wilt niet werken op uw manier.
U bent er wel van op de hoogte dat in mijn situatie de artikelnummers in kolom A staan en de inkoop/verkoop gegevens in kolom AT en AU?

Ik heb nu deze code:

Sub Missing2()
r = Sheets("Uitvoer").Range("A" & Rows.Count).End(xlUp).Row

For Each cl In Sheets("Uitvoer").Range("A4", "A" & r)

If Not IsEmpty(cl) And cl.Offset(0, 45).Value = 0 Or cl.Offset(0, 46).Value = 0 Then
Range("e" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 3).Value = Sheets("Uitvoer").Range(cl, cl.Offset(0, 45)).Value

End If
Next

End Sub

Hij print inderdaad de productnummers, maar hij tot slot kolom B en C als inkoop/verkoop prijs terwijl dit kolom AT en AU moeten zijn.

U gaf eerder al aan dat dit niet kan met de resize functie.

 

[Roeland035]

Het is al gelukt!

Sub Missing2()

lastrow = Sheets("Uitvoer").Columns("AT:AU").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row

For Each cl In Sheets("Uitvoer").Range("A4", "A" & lastrow)

If Not IsEmpty(cl) And cl.Offset(0, 45).Value = "" Or cl.Offset(0, 46).Value = "" Then
Range("e" & Rows.Count).End(xlUp).Offset(1, 0).Value = Range(cl.Offset(0, 0), cl.Offset(0, 0)).Value
Range("e" & Rows.Count).End(xlUp).Offset(0, 1).Value = Range(cl.Offset(0, 45), cl.Offset(0, 45)).Value
Range("e" & Rows.Count).End(xlUp).Offset(0, 2).Value = Range(cl.Offset(0, 46), cl.Offset(0, 46)).Value

End If
Next
End Sub