tabel omzetten naar iets leesbaars...

[Marij84]

Beste

In het tabbladje "content of roles" zie je TABEL 2 staan
Deze tabel heeft links "role number" staan en bovenaan de titels
(in de tabel erboven zie je dezelfde tabel staan, maar met kruisjes. deze kruisjes hebben een naam gekregen (dezelfde als de titel)
Nu zouden we een tabel moeten zien te maken , met erin enkel de Role numbers en de ingevulde titels
Zodat je in 1 tabel mooi kan aflezen welke titel bij welke role number is aangeduid
want nu is dat echt onoverzichtelijke en veel te veel te witte velden nog

Ik weet niet hoe ik hieraan moet beginnen

Kan iemand helpen?

Als er iets niet duidelijk is, vraag gerust, want niet evident om goed uit te leggen

Alvast bedankt!

mvg

Bijlage op verzoek weggehaald.

 

[Elsendoorn2134]

Marij84,

Begrijp ik het goed dat je een lijst wilt met "Role Number" en "Titel" hebben?
Alleen de Role Number of ook de omschrijving.
Wat je dus nodig hebt is een macro die alle cellen afloopt van G7 t/m EY29 en voor ieder kruisje dat hij
hierin tegenkomt een regel schrijft in een lijst?
Wil je deze lijst op een apart tabblad of onder aan tabel 2?

Elsendoorn2134

 

[cow18]

ik schrijf gewoon naar HA1 van dat blad, omdat ik anders niet wist waar naar toe.

Sub Roles2Tabel()
  Dim dict As Object, sn, i As Integer, j As Integer, i1 As Integer, arr(1 To 1, 1 To 7), bRij As Boolean

  sn = Sheets("content of roles").Range("A5").CurrentRegion  'uitlezen van je bereik naar een array

  Set dict = CreateObject("scripting.dictionary")          'aanmaken dictionary
  With dict                                                'met die dictionary
    For i = 4 To UBound(sn)                                'loopje vanaf de 4e rij van je array
      For j = 7 To UBound(sn, 2)                           'loopje vanaf de 7e kolom van je array
        If sn(i, j) = "x" Then                             'staat daar een x-je
          For i1 = 1 To 4: arr(1, i1) = sn(i, i1): Next    'neem de 1e 4 elementen uit die rij over
          For i1 = 5 To 7: arr(1, i1) = sn(i1 - 4, j): Next  'neem de 1e 3 elementen uit die kolom over
          .Item(.Count) = arr                              'schrijf ze naar je dictionary
        End If
      Next
    Next
  End With

  With Sheets("content of roles").Range("HA1")             'linkerbovenhoek van je bereik waar we naar toe schrijven
    .Resize(, UBound(arr, 2)).EntireColumn.ClearContents   'maak zoveel kolommen leeg als we per item elementen weggeschreven hebben
    If dict.Count Then .Resize(dict.Count, UBound(arr, 2)).Value = Application.Index(dict.items, 0, 0)  'schrijf je dictionary naar hier
    .Resize(, UBound(arr, 2)).EntireColumn.AutoFit   'kolombreedte aanpassen
  End With
End Sub

 

[Marij84]

ow .... thx
hier had ik noooit zelf opgekomen
Ga ik zeker en vast proberen.

Het mocht in een apart tabblad komen, maar maakt niet uit
als dit werkt komen we al een heel eind verder

groetjes