Overzicht maken van alleen ingevulde cellen

[patrixweb]

Goedemorgen experts,

Graag zou ik gebruikmaken van jullie expertise op gebied van excel formules en VBA.

Ik zou graag aan de hand van ingevulde cellen (Blad1) een overzicht willen creëren (blad2). Het is bedoeld om een afwezigheidoverzicht te creëren die ik dan in PDF kan verzenden per mail. (deze formules en VBA heb ik)

In de bijlage een voorbeeldbestandje.

Bij voorbaat dank

 

[emields]

bedoel je zoiets?

 

[AlexCEL]

Excel 365:

B19: =TRANSPONEREN(FILTER(C5:L5;FILTER(C6:L8;B6:B8=F16;"")<>"";""))
C19: =LET(x;FILTER(C6:L8;B6:B8=F16;"");TRANSPONEREN(FILTER(x;x<>"";"")))

 

[patrixweb]

bedoel je zoiets?

Hoi Emields,

Bijna, ik realiseer mij dat het voorbeeldbestand misschien wat summier was. Daarom heb ik een betere gemaakt en hopelijk een goed beeld geeft wat ik bedoel.

 

[AlexCEL]

Zie #3. Als je tenminste Excel 365 gebruikt. Even verwijzingen aanpassen en klaar.

 

[patrixweb]

Zie #3. Als je tenminste Excel 365 gebruikt. Even verwijzingen aanpassen en klaar.

Hoi AlexCel,

Ik gebruik Excel 2010

 

[AlexCEL]

Het kan ook in eerdere versies van Excel, alleen wordt het dan wat complexer. Zie bijlage.

Let op: de gebruikte formules zijn zogenaamde matrixfuncties, die moet je afsluiten met Control+Shift+Enter na wijzigen/invoeren. Daarna kun je ze doortrekken naar onder naar behoefte.

 

[emields]

of zo met een macro

 

[HSV]

Minder interactie met het blad.

Sub hsv()
Dim sv, sq, r, j As Long, n As Long
With Sheets("blad1")
sv = .Range("a5", .Cells(Rows.Count, 1).End(xlUp)).Resize(, .Cells(5, Columns.Count).End(xlToLeft).Column)
r = Application.Match(Sheets("blad2").Cells(4, 9), Application.Index(sv, 0, 1), 0)
If IsNumeric(r) Then
    sq = sv
      For j = 4 To UBound(sv, 2)
        Select Case UCase(sv(r, j))
          Case "V", "ATV", "Z"
                  n = n + 1
           sq(1, n) = CLng(sv(1, j))
           sq(2, n) = sv(r, j)
        End Select
     Next j
  If n > 0 Then
    With Sheets("blad2").Range("b12")
      .CurrentRegion.Offset(1).ClearContents
      .Resize(n, 2) = Application.Transpose(sq)
    End With
  End If
End If
End With
End Sub

Of:

Sub hsv()
Dim sv, sq, r, j As Long, n As Long
With Sheets("blad1")
sv = .Range("a5", .Cells(Rows.Count, 1).End(xlUp)).Resize(, .Cells(5, Columns.Count).End(xlToLeft).Column)
r = Application.Match(Sheets("blad2").Cells(4, 9), Application.Index(sv, 0, 1), 0)
If IsNumeric(r) Then
    sq = sv
      For j = 4 To UBound(sv, 2)
        If sv(r, j) <> "" Then
                  n = n + 1
           sq(1, n) = CLng(sv(1, j))
           sq(2, n) = sv(r, j)
        End If
     Next j
  If n > 0 Then
    With Sheets("blad2").Range("b12")
      .CurrentRegion.Offset(1).ClearContents
      .Resize(n, 2) = Application.Transpose(sq)
    End With
  End If
End If
End With
End Sub

 

[patrixweb]

of zo met een macro

Top!! Dank je wel...dit is precies wat ik zocht.

 

[patrixweb]

Opgelost

Dank allen voor jullie suggesties en hulp. :thumb: