Matrix t.b.v. opsomming

[tomaz]

Hallo,

Ik heb een vraag m.b.t. een matrix welke ik met behulp van jullie heb opgesteld. Graag zou ik de matrix willen uitbreiden, in de bijlage heb ik het voorbeeld uitgewerkt.

alvast bedankt en in afwachting van jullie reactie

Met vriendelijke groet,
Tom

Bekijk bijlage Matrix.xlsx

 

[HSV]

Geen matrix, maar VBA code.

Sub HSV()
 Range("A30:D" & Cells.SpecialCells(xlCellTypeLastCell).Row).ClearContents
  Dim rij As Integer, kol As Integer, sq As Variant
    For rij = 8 To Range("A8").CurrentRegion.Row + 8
     For kol = 7 To 10
   If Cells(rij, kol) = "x" Then
     sq = "code" & "|" & "naam" & "|" & "plaats" & "|" & "indexen" & "|"
       Range("A30").Resize(, 4) = Split(sq, "|")
      Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 3).Value = Range(Cells(rij, 1), Cells(rij, 3)).Value
     Cells(Rows.Count, 4).End(xlUp).Offset(1) = Cells(rij, kol - 3)
    End If
   Next kol
  Next rij
End Sub

 

[sa11]

of zoiets met vert.zoeken, zie bijlage
succes..

 

[tomaz]

'RE: Matrix t.b.v. opsomming'

Hartelijk dank voor jullie snelle reactie!

Ik ben met matrix vergekomen alleen dacht ik wel even de VBA code te kunnen aanpassen om de range aan te passen naar het definitieve document, maar dit valt tegen!

In de bijlage heb ik dan maar het definitieve document toegevoegd. Ik hoop niet dat het teveel moeite is om de code aan te passen, excuus voor het ongemak.

Alvast enorm bedankt!!!

Groet Tom Dekker

Bekijk bijlage Disipline bestand STABU.xlsx

 

[HSV]

Hierbij de aangepaste versie.

Sub HSV()
Dim rij As Integer, kol As Integer, sq As Variant
 With Sheets("MACROLIJST SAMENVATTING")
  .Range("A2:Q" & .Cells.SpecialCells(xlCellTypeLastCell).Row).ClearContents
 sq = "Nr" & "|" & "Naam" & "|" & "Plaats" & "|" & "Adres" & "|" & "Telefoon" & "|" & "Land-/regiocode" _
     & "|" & "Fax" & "|" & "Postcode" & "|" & "E-mail" & "|" & "Homepage" & "|" & "Soort" & "|" & _
     "Aanhefcode" & "|" & "Bezoekadres" & "|" & "Bezoekplaats" & "|" & "Bezoekpostcode" & "|" & "Aanhef soort" & "|" & _
     "Indexcode (""x"")" & "|"
           .Range("A1").Resize(, 17) = Split(sq, "|")
  
    For rij = 2 To Sheets("KRUISLIJST").Cells(.Rows.Count, 1).End(xlUp).Row
     For kol = 17 To 399
   If Sheets("KRUISLIJST").Cells(rij, kol) = "x" Then
      .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 16).Value = Sheets("KRUISLIJST").Range(Sheets("KRUISLIJST").Cells(rij, 1), Sheets("KRUISLIJST").Cells(rij, 16)).Value
     .Cells(Rows.Count, 17).End(xlUp).Offset(1) = Sheets("KRUISLIJST").Cells(1, kol)
    End If
   Next kol
  Next rij
 End With
End Sub

 

[tomaz]

Re:

Super! Hij werkt nu uitstekend! Bedankt voor de gedane moeite!