Yritin luoda tuplasilmukkaa vba:lla exceliin, mutta menin solmuun...osaisiko joku auttaa:
Tarkoitus on luoda matriisi, jonka diagonaalille poimitaan arvoja. Ideana on lähteä matriisin nurkasta liikkeelle ja katsoa saraketta B kunnes sieltä löytyy ensimmäinen ykkönen. Kun se löytyy, otetaan sen vierestä sarakkeesta A numero ja laitetaan se matriisin nurkkaan. Sitten mennään diagonaalin seuraavaan soluun ja jatketaan taas B-sarakkeesta etsimällä seuraava ykkönen.
Jotain tämmöistä yritin:
Sub yritys()
x = 7 'x ja y määrää matriisin nurkan
y = 4
' Tässä yritän mennä B-saraketta alas, kunnes ' ensimmäinen ykkönen tulee vastaan
For Each c In Worksheets("calculations").Range("B4:B400").Cells
Do While c.Value 1
' jos ykköstä ei löydy, mennään alaspäin
ActiveCell.Offset(1, 0).Select
Set Rw = ActiveCell.Row
Loop
' kun ykkönen löytyy, diagonaalille laitetaan 'A-sarakkeesta arvo. Tässä kohtaa on virhe.
If c.Value = 1 Then Cells(y, x).Value = Cells.Value(Rw, 1)
x = x 1
y = y 1
Cells(Rw, 5).Activate
Next
End Sub
Tarkoitus on luoda matriisi, jonka diagonaalille poimitaan arvoja. Ideana on lähteä matriisin nurkasta liikkeelle ja katsoa saraketta B kunnes sieltä löytyy ensimmäinen ykkönen. Kun se löytyy, otetaan sen vierestä sarakkeesta A numero ja laitetaan se matriisin nurkkaan. Sitten mennään diagonaalin seuraavaan soluun ja jatketaan taas B-sarakkeesta etsimällä seuraava ykkönen.
Jotain tämmöistä yritin:
Sub yritys()
x = 7 'x ja y määrää matriisin nurkan
y = 4
' Tässä yritän mennä B-saraketta alas, kunnes ' ensimmäinen ykkönen tulee vastaan
For Each c In Worksheets("calculations").Range("B4:B400").Cells
Do While c.Value 1
' jos ykköstä ei löydy, mennään alaspäin
ActiveCell.Offset(1, 0).Select
Set Rw = ActiveCell.Row
Loop
' kun ykkönen löytyy, diagonaalille laitetaan 'A-sarakkeesta arvo. Tässä kohtaa on virhe.
If c.Value = 1 Then Cells(y, x).Value = Cells.Value(Rw, 1)
x = x 1
y = y 1
Cells(Rw, 5).Activate
Next
End Sub
Vastaukset 1
Vanhimmat
Sub yritys()
x = 7 'x ja y määrää matriisin nurkan
y = 4
' Tässä yritän mennä B-saraketta alas, kunnes ' ensimmäinen ykkönen tulee vastaan
For Each c In Range("B4:B400")
If c.Value = 1 Then
Cells(y, x).Value = Cells(c.Row, 1).Value
x = x 1
y = y 1
End If
Next
End Sub