In Excel met vba van een matrix een tabel maken

[uomo41]

Hallo,

Ik ben al een tijdje aan het worstelen met vba om van een matrix een tabel te maken.
De code zoekt in de matrix naar de waarde -1. Als deze gevonden wordt kopieert de code de eerste 3 kolommen. Ik zoek nu de code om vervolgens deze velden in een nieuw werkblad te kopieeren. Behalve de eerste 3 velden moet ook het bovenste veld (in het voorbeeld 28) gekopieert en in de tabel geplaats worden.

De matrix ziet er als volgt uit:

Totaal 28 29 30
42117130 80 201 9 0 -1 -1
42117130 80 202 1 -1 -1 -1
42117130 80 203 5 -1 -1 -1
42117130 80 204 4 -1 -1 -1
42117130 80 206 3 -1 -1 -1
42117130 80 207 9 -1 -1 -1
42117130 80 208 10 0 -1 0
42117130 80 209 6 -1 -1 0

De output moet er zo uit komen te zien:

Art Klr Mtn Van Naar Aantal
42117130 80 28 202

Dit is de code die ik al heb:

Sub ColorCells()

Dim rngvrd As range
Dim lRow As Long, lColumn As Long

range("E2").Select
range(Selection, Selection.End(xlDown)).Select
range(Selection, Selection.End(xlToRight)).Select
ActiveWorkbook.Names.Add Name:="aantallen", RefersToR1C1:=Selection

Set rngvrd = range("aantallen")

For lRow = 1 To rngvrd.Rows.Count
For lColumn = 1 To rngvrd.Columns.Count

If ActiveCell.Offset(lRow - 1, lColumn - 1).Value = -1 Then
ActiveCell.Offset(lRow - 1, lColumn - 1).Font.ColorIndex = 3
range(ActiveCell.Offset(lRow - 1, -4), ActiveCell.Offset(lRow - 1, -2)).Copy

Else

If ActiveCell.Offset(lRow - 1, lColumn - 1).Value = 1 Then
ActiveCell.Offset(lRow - 1, lColumn - 1).Font.ColorIndex = 6

End If
End If

Next lColumn
Next lRow


End Sub

Wie weet raad? Alvast bedankt voor de hulp...

 

[etri]

Het eerste deel ziet er m.i. goed uit. Ik zou voor het tweede deel anders te werk gaan.
Je kunt een range aanmaken voor alleen de getallen/waarden die je wilt onderzoeken of er een "-1" in voorkomt. Stel we noemen die range "waarden", dan staan alle waarden in:

Range("waarden").Value2

Op deze manier door de waarden heenlopen is sneller en (naar mijn mening) makkelijker.

Value2 is een lijst van 2 dimensies: 1e dimensie is de rijen, 2e is de kolommen. Voor rij 2 en kolom 3 haal je dus de waarde als volgt op:

Range("waarden").Value2(2,3)

Nu kun je met een lus alle waarden afgaan:

    Dim iRow As Integer
    Dim iCol As Integer
    Dim vWaarde As Variant
    Dim myRange As Range
    
    Set myRange = Range("waarden")
    
    For iRow = 1 To UBound(myRange.Value2, 1)
        For iCol = 1 To UBound(myRange.Value2, 2)
            vWaarde = myRange.Value2(iRow, iCol)
        Next iCol
    Next iRow

Succes! Misschien heb ik je hiermee wat verder op weg geholpen...