köşegen matris

[fehamu]

Merhaba arkadaşlar.
Örneğin 10 satır 10 sütunluk bir matris tablosu elimde varsa ve bunun sadece köşegen elemanlarını yerinde bırakıp diğerlerine sıfır değeri atamak istiyorsam kullanacağım vba kodu ne olmalıdır. Tablom çalışma sayfasının herhangi bir lokasyonunda olabiliyor belli bir yeri yoktur. tablo alanını çevirerek seçtikten sonra otomatik olarak içindeki hücre değerlerini söylediğim şekilde değiştirmek istiyorum. yardımcı olabilirmisiniz.
Aslında köşegen elemanlarını da kendi karekökleriyle değiştirmek de istiyorum ancak bu sonraki iş. Şimdilik bunu tek tek üzerine tıklayınca karekökünü alan bir makroyla yapıyorum.

 

[fehamu]

for next döngüsüyle mi yapılabilir? nasıl?
Not: tablom çalışma sayfasının herhangi bir yerinde olabiliyor. O nedenle tablo sınırlarını çevirdikten sonra makroyu çalıştırmam gerekiyor. işe böyle başlamalıyım diye düşünüyorum.
mesela zihnimde şöyle bir algoritma var.
for i= 1 to 10
for J=1 to 10
if i eşit değil j ise ij elemanının değerine 0 değerini ata.
Tablodaki satır ve sütun sayısı değişebiliyor. Bu nedenle öncelikle sınırları seçili tablonun satır sayısını saydırmak ve buna göre de birinci satır birinci sütun elemanıyla döngüyü başlatmak gerekir. Nasıl bir syntax kullanacağımı bilemiyorum.

 

[fehamu]

mesela zihnimde şöyle bir algoritma var.
for i= 1 to 10
for J=1 to 10
if i eşit değil j ise ij elemanının değerine 0 değerini ata.
Ttablodaki satır ve sütun sayısı değişebiliyor. Bu nedenle öncelikle sınırları seçili tablonun satır sayısını saydırmak ve buna göre de birinci satır birinci sütun elemanıyla döngüyü başlatmak gerekir. Nasıl bir syntax kullanacağımı bilemiyorum.

 

[Merhum İdris SERDAR]

.

Alt ve üst için ayrı kodlar ile bunların ikisini çalıştıran bir kodu aşağıda veriyorum.

Option Explicit
Sub altusts()

MatrisUstS
MatrisAltS

End Sub

Sub MatrisUstS()

    Dim aln As Range, i As Long, j As Long
    Set aln = ActiveCell.CurrentRegion
    For j = 1 To aln.Columns.Count
    
        For i = 1 To j - 1
            aln.Cells(i, j) = 0
            Next i
        Next j
    
    End Sub

Sub MatrisAltS()
    Dim aln As Range, x As Long, y As Long
    Set aln = ActiveCell.CurrentRegion
    For y = 1 To aln.Rows.Count
    
        For x = 1 To y - 1
            aln.Cells(y, x) = 0
            Next x
        Next y
    
    End Sub

Bu da tek makro.

Sub MatrisaltUstS()

    Dim aln As Range, i As Long, j As Long, x As Long, y As Long
    Set aln = ActiveCell.CurrentRegion
    
    For j = 1 To aln.Columns.Count
    
        For i = 1 To j - 1
            aln.Cells(i, j) = 0
            Next i
        Next j
    
    For y = 1 To aln.Rows.Count
    
        For x = 1 To y - 1
            aln.Cells(y, x) = 0
            Next x
        Next y
    
    End Sub

.

 

[fehamu]

çok teşekkürler. tam aradığım şey .Sağolunuz