bereday21

VB de Matriks Algoritmaları

Burada yazilan fonksiyonlar iki boyut düsünülerek yazilmistir**
'************************************************* **************/

Option Explicit
Option Base 1

Private Type MaTRikS_TanImlanmaSi
Kolon_Sayisi As Integer
SatiR_Sayisi As Integer
BoyuT_Sayisi As Integer
End Type

Public Const ToleRanS = 0.00000000001 '10E-12

Public Function MaTriKs_BoyUtu(ByRef MaTriKs As Variant) As Integer

Dim sInIr As Integer, Boyut As Integer
Const OlabiliR_eN_bUyUk_BoyUt = 10

On Local Error GoTo HATA

For Boyut = 1 To OlabiliR_eN_bUyUk_BoyUt Step 1
sInIr = UBound(MaTriKs, Boyut)
Next Boyut

Exit Function

HATA:
MaTriKs_BoyUtu = Boyut - 1

End Function

Public Function iC_MatRiKS(ByRef MaTriKs As Variant, ByRef Start_SAtir As Integer, ByRef End_SAtir As Integer, ByRef Start_KoLon As Integer, ByRef End_KoLon As Integer, ByRef Result As Variant, Optional ByRef TekBoyuta_Izin As Boolean) As Boolean

Dim SAtir As Integer, KoLon As Integer

If LBound(MaTriKs, 1) > Start_SAtir Or LBound(MaTriKs, 2) > Start_KoLon Then ' Alt sinirlar kontrol ediliyor
MsgBox "İç Matriks'in alt sınırlarından biri veya ikisi de Orjinal Matriks'in alt sınırından küçük.", vbCritical + vbOKOnly, "HATA"
iC_MatRiKS = False
Exit Function
End If

If UBound(MaTriKs, 1) < End_SAtir Or UBound(MaTriKs, 2) < End_KoLon Then ' Ust sinirlar kontrol ediliyor
MsgBox "İç Matriks'in üst sınırlarından biri veya ikisi de Orjinal Matriks'in üst sınırından büyük.", vbCritical + vbOKOnly, "HATA"
iC_MatRiKS = False
Exit Function
End If

If End_SAtir < Start_SAtir Or End_KoLon < Start_KoLon Then
MsgBox "iC_MatRiKS işleminde alt sınırlar kendi üst sınırlardan daha büyük olamazlar.", vbExclamation + vbOKOnly, "HATA"
iC_MatRiKS = False
Exit Function
End If

If IsNull(TekBoyuta_Izin) = True Then TekBoyuta_Izin = True

If End_SAtir - Start_SAtir = 0 Or End_KoLon - Start_KoLon = 0 And TekBoyuta_Izin = True Then
SAtir = Max(End_SAtir - Start_SAtir + 1, End_KoLon - Start_KoLon + 1)
ReDim Result(SAtir)

If End_SAtir - Start_SAtir = 0 Then

While SAtir >= 1
Result(SAtir) = MaTriKs(End_SAtir, SAtir)
SAtir = SAtir - 1
Wend

Else

While SAtir >= 1
Result(SAtir) = MaTriKs(SAtir, End_KoLon)
SAtir = SAtir - 1
Wend

End If

ElseIf End_SAtir - Start_SAtir = 0 Or End_KoLon - Start_KoLon = 0 And TekBoyuta_Izin = False Then
SAtir = Max(End_SAtir - Start_SAtir + 1, End_KoLon - Start_KoLon + 1)
ReDim Result(SAtir, 1)

If End_SAtir - Start_SAtir = 0 Then

While SAtir >= 1
Result(SAtir, 1) = MaTriKs(End_SAtir, SAtir)
SAtir = SAtir - 1
Wend

Else

While SAtir >= 1
Result(SAtir, 1) = MaTriKs(SAtir, End_KoLon)
SAtir = SAtir - 1
Wend

End If

Else
ReDim Result(End_SAtir - Start_SAtir + 1, End_KoLon - Start_KoLon + 1)

For SAtir = Start_SAtir To End_SAtir Step 1 ' Result matriksinin icine istenen degerler yerlestiriliyor

For KoLon = Start_KoLon To End_KoLon Step 1
Result(SAtir - Start_SAtir + 1, KoLon - Start_KoLon + 1) = MaTriKs(SAtir, KoLon)
Next KoLon

Next SAtir

End If

iC_MatRiKS = True

End Function

Public Function SaTir_SiL(ByRef MaTriKs As Variant, ByRef SiliNEcek_SaTir As Integer, ByRef Result As Variant) As Boolean

Dim SAtir As Integer, KoLon As Integer
Dim deleted As Integer
Dim MtRkS As MaTRikS_TanImlanmaSi

MtRkS.BoyuT_Sayisi = MaTriKs_BoyUtu(MaTriKs)

If MtRkS.BoyuT_Sayisi < 2 Then
MsgBox "Uygun formatta matriks bulunamadı.", vbCritical + vbOKOnly, "Eksik Boyut"
SaTir_SiL = False
Exit Function
End If

MtRkS.SatiR_Sayisi = UBound(MaTriKs, 1) 'matriksin satir ve kolon sayilari bulunuyor
MtRkS.Kolon_Sayisi = UBound(MaTriKs, 2)

If MtRkS.SatiR_Sayisi < SiliNEcek_SaTir Or SiliNEcek_SaTir < 1 Then
MsgBox "Silinecek satır numarası 1 ile orjinal matriksin satır sayısı arasında olmalıdır.", vbExclamation + vbOKOnly, "HATA"
SaTir_SiL = False
Exit Function
End If

ReDim Result(MtRkS.SatiR_Sayisi - 1, MtRkS.Kolon_Sayisi)
SaTir_SiL = True

deleted = 0
For SAtir = 1 To MtRkS.SatiR_Sayisi Step 1

If SAtir <> SiliNEcek_SaTir Then

For KoLon = 1 To MtRkS.Kolon_Sayisi Step 1
Result(SAtir - deleted, KoLon) = MaTriKs(SAtir, KoLon)
Next KoLon

Else
deleted = 1 ' Burada deleted 1 degerini yukaridaki for dongusunun icine tasiyor boylece 1 sayi azaltilmis oluyor
End If

Next SAtir

SaTir_SiL = True

End Function

Public Function Erase_KoLon(ByRef MaTriKs As Variant, ByRef SiliNEcek_KoloN As Integer, ByRef Result As Variant) As Boolean

Dim SAtir As Integer, KoLon As Integer
Dim deleted As Integer
Dim MtRkS As MaTRikS_TanImlanmaSi

MtRkS.SatiR_Sayisi = UBound(MaTriKs, 1) 'matriksin satir ve kolon sayilari bulunuyor
MtRkS.Kolon_Sayisi = UBound(MaTriKs, 2)

If MtRkS.Kolon_Sayisi < SiliNEcek_KoloN Or SiliNEcek_KoloN < 1 Then
MsgBox "Silinecek kolon numarası 1 ile orjinal matriksin kolon sayısı arasında olmalıdır.", vbExclamation + vbOKOnly, "HATA"
Erase_KoLon = False
Exit Function
End If

If MtRkS.Kolon_Sayisi < 1 Then 'eger matriks bos ise
Erase_KoLon = False
Exit Function
End If

ReDim Result(MtRkS.SatiR_Sayisi, MtRkS.Kolon_Sayisi - 1)
Erase_KoLon = True

deleted = 0
For SAtir = 1 To MtRkS.SatiR_Sayisi Step 1

For KoLon = 1 To MtRkS.Kolon_Sayisi Step 1

If KoLon <> SiliNEcek_KoloN Then
Result(SAtir, KoLon - deleted) = MaTriKs(SAtir, KoLon)
Else
deleted = 1 ' Burada deleted 1 degerini yukaridaki for dongusunun icine tasiyor boylece 1 sayi azaltilmis oluyor
End If

Next KoLon

Next SAtir

Erase_KoLon = True

End Function

Public Function Altina_EkLE(ByRef UST_MaTriKs As Variant, ByRef ALT_MaTriKs As Variant, ByRef Result As Variant) As Boolean

Dim SAtir As Integer, KoLon As Integer, SatiR_Sayisi As Integer
Dim usT_mTrx_KoLon_islEmsEl As Integer, alT_mTrx_KoLon_islEmsEl As Integer
Dim MtRkS_AlT As MaTRikS_TanImlanmaSi, MtRkS_USt As MaTRikS_TanImlanmaSi

MtRkS_AlT.BoyuT_Sayisi = MaTriKs_BoyUtu(ALT_MaTriKs)
MtRkS_USt.BoyuT_Sayisi = MaTriKs_BoyUtu(UST_MaTriKs)

If MtRkS_AlT.BoyuT_Sayisi = 0 Or MtRkS_USt.BoyuT_Sayisi = 0 Then
MsgBox "Birleştirilmek istenen matrikslerden biri veya ikisi de matriks formunda değilller.", vbExclamation + vbOKOnly, "HATA"
Altina_EkLE = False
Exit Function
End If

MtRkS_USt.SatiR_Sayisi = UBound(UST_MaTriKs, 1)
If MaTriKs_BoyUtu(UST_MaTriKs) = 1 Then
MtRkS_USt.Kolon_Sayisi = 0
usT_mTrx_KoLon_islEmsEl = MtRkS_USt.SatiR_Sayisi
SatiR_Sayisi = MtRkS_USt.SatiR_Sayisi
Else
MtRkS_USt.Kolon_Sayisi = UBound(UST_MaTriKs, 2)
usT_mTrx_KoLon_islEmsEl = MtRkS_USt.Kolon_Sayisi
SatiR_Sayisi = 1
End If

MtRkS_AlT.SatiR_Sayisi = UBound(ALT_MaTriKs, 1)
If MaTriKs_BoyUtu(ALT_MaTriKs) = 1 Then
MtRkS_AlT.Kolon_Sayisi = 0
alT_mTrx_KoLon_islEmsEl = MtRkS_AlT.SatiR_Sayisi
SatiR_Sayisi = SatiR_Sayisi + MtRkS_AlT.SatiR_Sayisi
Else
MtRkS_AlT.Kolon_Sayisi = UBound(ALT_MaTriKs, 2)
alT_mTrx_KoLon_islEmsEl = MtRkS_AlT.Kolon_Sayisi
SatiR_Sayisi = SatiR_Sayisi + 1
End If

If usT_mTrx_KoLon_islEmsEl <> alT_mTrx_KoLon_islEmsEl Then
MsgBox "Birleştirilmeye çalışılan matrikslerin kolon sayıları aynı değil.", vbExclamation + vbOKOnly, "HATA"
Altina_EkLE = False
Exit Function
End If

ReDim Result(SatiR_Sayisi, usT_mTrx_KoLon_islEmsEl)

If MtRkS_USt.Kolon_Sayisi > 0 Then

For SAtir = 1 To MtRkS_USt.SatiR_Sayisi Step 1

For KoLon = 1 To MtRkS_USt.Kolon_Sayisi Step 1
Result(SAtir, KoLon) = UST_MaTriKs(SAtir, KoLon)
Next KoLon

Next SAtir

Else
SAtir = 1

For KoLon = 1 To usT_mTrx_KoLon_islEmsEl Step 1
Result(SAtir, KoLon) = UST_MaTriKs(KoLon)
Next KoLon

End If

If MtRkS_AlT.Kolon_Sayisi > 0 Then

For SAtir = 1 To MtRkS_AlT.SatiR_Sayisi Step 1

For KoLon = 1 To MtRkS_AlT.Kolon_Sayisi Step 1
Result(SAtir + MtRkS_USt.SatiR_Sayisi, KoLon) = ALT_MaTriKs(SAtir, KoLon)
Next KoLon

Next SAtir

Else
SAtir = MtRkS_USt.SatiR_Sayisi + 1

For KoLon = 1 To MtRkS_AlT.SatiR_Sayisi Step 1
Result(SAtir, KoLon) = ALT_MaTriKs(KoLon)
Next KoLon

End If

Altina_EkLE = True

End Function

__________________

| Üye İmzalarını Görmek İçin Buraya Tıklayarak Kayıt Olabilirsiniz. |

bereday21

Public Function YaniNa_EkLE(ByRef SOL_MaTriKs As Variant, ByRef SAG_MaTriKs As Variant, ByRef Result As Variant) As Boolean

Dim SAtir As Integer, KoLon As Integer
Dim Sag_Mtrx_KoLon_Islemsel As Integer, Sol_Mtrx_KoLon_Islemsel As Integer
Dim MtRkS_SoL As MaTRikS_TanImlanmaSi, MtRkS_SaG As MaTRikS_TanImlanmaSi

MtRkS_SoL.BoyuT_Sayisi = MaTriKs_BoyUtu(SOL_MaTriKs)
MtRkS_SaG.BoyuT_Sayisi = MaTriKs_BoyUtu(SAG_MaTriKs)

If MtRkS_SoL.BoyuT_Sayisi = 0 Or MtRkS_SaG.BoyuT_Sayisi = 0 Then
MsgBox "Birleştirilmek istenen matrikslerden biri veya ikisi de matriks formunda değilller.", vbExclamation + vbOKOnly, "HATA"
YaniNa_EkLE = False
Exit Function
End If

MtRkS_SoL.SatiR_Sayisi = UBound(SOL_MaTriKs, 1)
If MtRkS_SoL.BoyuT_Sayisi = 1 Then
MtRkS_SoL.Kolon_Sayisi = 0
Sol_Mtrx_KoLon_Islemsel = 1
Else
MtRkS_SoL.Kolon_Sayisi = UBound(SOL_MaTriKs, 2)
Sol_Mtrx_KoLon_Islemsel = MtRkS_SoL.Kolon_Sayisi
End If

MtRkS_SaG.SatiR_Sayisi = UBound(SAG_MaTriKs, 1)
If MtRkS_SaG.BoyuT_Sayisi = 1 Then
MtRkS_SaG.Kolon_Sayisi = 0
Sag_Mtrx_KoLon_Islemsel = 1
Else
MtRkS_SaG.Kolon_Sayisi = UBound(SAG_MaTriKs, 2)
Sag_Mtrx_KoLon_Islemsel = MtRkS_SaG.Kolon_Sayisi
End If

If MtRkS_SoL.SatiR_Sayisi <> MtRkS_SaG.SatiR_Sayisi Then
MsgBox "Birleştirilmeye çalışılan matrikslerin satır sayıları aynı değil.", vbExclamation + vbOKOnly, "HATA"
YaniNa_EkLE = False
Exit Function
End If

ReDim Result(MtRkS_SoL.SatiR_Sayisi, Sol_Mtrx_KoLon_Islemsel + Sag_Mtrx_KoLon_Islemsel)

If MtRkS_SoL.Kolon_Sayisi > 0 Then

For SAtir = 1 To MtRkS_SoL.SatiR_Sayisi Step 1

For KoLon = 1 To MtRkS_SoL.Kolon_Sayisi Step 1
Result(SAtir, KoLon) = SOL_MaTriKs(SAtir, KoLon)
Next KoLon

Next SAtir

Else
KoLon = 1

For SAtir = 1 To MtRkS_SoL.SatiR_Sayisi Step 1
Result(SAtir, KoLon) = SOL_MaTriKs(SAtir)
Next SAtir

End If


If MtRkS_SaG.Kolon_Sayisi > 0 Then

For SAtir = 1 To MtRkS_SaG.SatiR_Sayisi Step 1

For KoLon = 1 To MtRkS_SaG.Kolon_Sayisi Step 1
Result(SAtir, KoLon + Sol_Mtrx_KoLon_Islemsel) = SAG_MaTriKs(SAtir, KoLon)
Next KoLon

Next SAtir

Else
KoLon = Sol_Mtrx_KoLon_Islemsel + 1

For SAtir = 1 To MtRkS_SaG.SatiR_Sayisi Step 1
Result(SAtir, KoLon) = SAG_MaTriKs(SAtir)
Next SAtir

End If

YaniNa_EkLE = True

End Function

Public Function MtrX_mLtP(ByRef MaTriKs1 As Variant, ByRef MaTriKs2 As Variant, ByRef Result As Variant) As Boolean

Dim i_r As Integer, i_c As Integer, i As Integer
Dim temp As Double
Dim MtRkS1 As MaTRikS_TanImlanmaSi, MtRkS2 As MaTRikS_TanImlanmaSi

MtRkS1.BoyuT_Sayisi = MaTriKs_BoyUtu(MaTriKs1)
MtRkS2.BoyuT_Sayisi = MaTriKs_BoyUtu(MaTriKs2)

If MtRkS1.BoyuT_Sayisi = 0 Or MtRkS2.BoyuT_Sayisi = 0 Then
MsgBox "Matrikslerden biri veya ikisi de uygun formatta değil.", vbCritical + vbOKOnly, "HATA"
MtrX_mLtP = False
Exit Function
End If

MtRkS1.SatiR_Sayisi = UBound(MaTriKs1, 1) 'matrikslerin kolon ve satir sayilari bulunuyor
If MtRkS1.BoyuT_Sayisi = 1 Then MtRkS1.Kolon_Sayisi = 1 Else: MtRkS1.Kolon_Sayisi = UBound(MaTriKs1, 2)

MtRkS2.SatiR_Sayisi = UBound(MaTriKs2, 1)
If MtRkS2.BoyuT_Sayisi = 1 Then MtRkS2.Kolon_Sayisi = 1 Else: MtRkS2.Kolon_Sayisi = UBound(MaTriKs2, 2)

If MtRkS1.Kolon_Sayisi <> MtRkS2.SatiR_Sayisi Then ' Eger 1. matriksin kolon sayisi ile 2. matriksin satir sayisi esit degilse carpma yapilamaz
MsgBox "Matriks çarpma işlemi gerçekleştirilemedi.", vbExclamation + vbOKOnly, "Uygun olmayan boyut hatasi"
MtrX_mLtP = False
Exit Function
End If

ReDim Result(MtRkS1.SatiR_Sayisi, MtRkS2.Kolon_Sayisi)
MtrX_mLtP = True

i_r = 1
While i_r <= MtRkS1.SatiR_Sayisi 'matriks carpma islemine baslaniyor

i_c = 1
While i_c <= MtRkS2.Kolon_Sayisi
temp = 0

i = 1
While i <= MtRkS1.Kolon_Sayisi ' veya i<=mtrks2.satir_sayisi
temp = temp + MaTriKs1(i_r, i) * MaTriKs2(i, i_c)
i = i + 1
Wend

Result(i_r, i_c) = temp
i_c = i_c + 1
Wend

i_r = i_r + 1
Wend

End Function
Public Function DeterMinAnt(ByRef MaTriKs As Variant) As Double

Dim det_coef As Integer, i_r As Integer, i_c As Integer
Dim temp() As Double, Mtrx_SAtir As Double

Mtrx_SAtir = UBound(MaTriKs, 1)
ReDim temp(Mtrx_SAtir, Mtrx_SAtir)

det_coef = EchEloN(True, MaTriKs, temp)

If det_coef = -1 Then
DeterMinAnt = "HATA"
Exit Function
End If

DeterMinAnt = 1

i_r = 1
While i_r <= Mtrx_SAtir
DeterMinAnt = temp(i_r, i_r) * DeterMinAnt
i_r = i_r + 1
Wend

DeterMinAnt = DeterMinAnt * PoWEr(-1, det_coef)

End Function

Public Function Forward_Gauss(ByRef EchelonFormOF_Coef_Mtrx As Variant, ByRef EchelonFormOF_Mtrx_X As Variant) As Boolean

Dim SAtir As Integer, KoLon As Integer, Mtrx_SAtir As Integer
Dim DeT As Double

If MaTriKs_BoyUtu(EchelonFormOF_Coef_Mtrx) <> 2 Then
Forward_Gauss = False
Exit Function
End If

Mtrx_SAtir = UBound(EchelonFormOF_Coef_Mtrx, 1)

DeT = 1
For SAtir = 1 To Mtrx_SAtir Step 1
DeT = DeT * EchelonFormOF_Coef_Mtrx(SAtir, SAtir)
Next SAtir

If Abs(DeT) <= ToleRanS And EchelonFormOF_Coef_Mtrx(Mtrx_SAtir, Mtrx_SAtir) = 0 Then
MsgBox "System has not a unique solution", vbExclamation + vbOKOnly, "Error"
Forward_Gauss = False
Exit Function
ElseIf Abs(DeT) <= ToleRanS Then
MsgBox "System has not a solution", vbCritical + vbOKOnly, "Error"
Forward_Gauss = False
Exit Function
End If


If MaTriKs_BoyUtu(EchelonFormOF_Mtrx_X) = 1 Then

For SAtir = Mtrx_SAtir To 1 Step -1
DeT = 0

KoLon = SAtir + 1
While KoLon <= Mtrx_SAtir
DeT = DeT + EchelonFormOF_Coef_Mtrx(SAtir, KoLon) * EchelonFormOF_Mtrx_X(KoLon)
KoLon = KoLon + 1
Wend

EchelonFormOF_Mtrx_X(SAtir) = (EchelonFormOF_Mtrx_X(SAtir) - DeT) / EchelonFormOF_Coef_Mtrx(SAtir, SAtir)
Next SAtir

Else

For SAtir = Mtrx_SAtir To 1 Step -1
DeT = 0

KoLon = SAtir + 1
While KoLon <= Mtrx_SAtir
DeT = DeT + EchelonFormOF_Coef_Mtrx(SAtir, KoLon) * EchelonFormOF_Mtrx_X(KoLon, 1)
KoLon = KoLon + 1
Wend

EchelonFormOF_Mtrx_X(SAtir, 1) = (EchelonFormOF_Mtrx_X(SAtir, 1) - DeT) / EchelonFormOF_Coef_Mtrx(SAtir, SAtir)
Next SAtir

End If

Forward_Gauss = True
End Function

Public Function EchEloN(ByRef Pivoting As Boolean, ByRef MaTriKs As Variant, ByRef Result As Variant) As Integer

Dim Mtrx_SAtir As Integer, MTrx_KoLon As Integer
Dim pivot As Integer, SAtir As Integer, KoLon As Integer, i As Integer, det_exp As Integer 'det_exp degiskeni pivoting sonucuna göre determinanta gelmesi gereken negatif degeri kontrol ediyor
Dim factor As Double, temp As Double

Mtrx_SAtir = UBound(MaTriKs, 1)
MTrx_KoLon = UBound(MaTriKs, 2)

ReDim Result(Mtrx_SAtir, MTrx_KoLon)

For SAtir = 1 To Mtrx_SAtir Step 1

For KoLon = 1 To MTrx_KoLon Step 1
Result(SAtir, KoLon) = MaTriKs(SAtir, KoLon)
Next KoLon

Next SAtir

det_exp = 0
EchEloN = 1

pivot = 1
While pivot < Mtrx_SAtir

If Pivoting = True Then

SAtir = pivot
For i = pivot + 1 To Mtrx_SAtir

If Abs(Result(SAtir, pivot)) < Abs(Result(i, pivot)) Then
SAtir = i
End If

Next i

If SAtir <> pivot Then
det_exp = det_exp + 1

For KoLon = 1 To MTrx_KoLon Step 1
temp = Result(pivot, KoLon)
Result(pivot, KoLon) = Result(SAtir, KoLon)
Result(SAtir, KoLon) = temp
Next KoLon

End If

End If

SAtir = pivot + 1

While SAtir <= Mtrx_SAtir

If Abs(Result(pivot, pivot)) < ToleRanS Then
MsgBox "Pivoting methodunu kullanın", vbCritical, "Sıfıra Bölme Hatası"
EchEloN = -1
Exit Function
End If

factor = Result(SAtir, pivot) / Result(pivot, pivot)

KoLon = 1
While KoLon <= MTrx_KoLon
Result(SAtir, KoLon) = Result(SAtir, KoLon) - Result(pivot, KoLon) * factor
KoLon = KoLon + 1
Wend

SAtir = SAtir + 1
Wend

pivot = pivot + 1
Wend

EchEloN = det_exp
End Function

Public Function TransPose(ByRef MaTriKs As Variant, ByRef Result As Variant) As Boolean

Dim SAtir As Integer, KoLon As Integer
Dim MtRkS As MaTRikS_TanImlanmaSi

MtRkS.BoyuT_Sayisi = MaTriKs_BoyUtu(MaTriKs)

If MtRkS.BoyuT_Sayisi <> 2 Then
MsgBox "Uygun formatta matriks bulunamadı.", vbCritical + vbOKOnly, "HATA"
TransPose = False
Exit Function
End If

MtRkS.SatiR_Sayisi = UBound(MaTriKs, 1)
MtRkS.Kolon_Sayisi = UBound(MaTriKs, 2)

For SAtir = 1 To MtRkS.SatiR_Sayisi Step 1

For KoLon = 1 To MtRkS.Kolon_Sayisi Step 1
Result(KoLon, SAtir) = MaTriKs(SAtir, KoLon)
Next KoLon

Next SAtir

TransPose = True

End Function

Public Function MatriKs_YazDir(ByRef BasliK As String, ByRef MaTriks_Adi As Variant, Optional ByRef YuvarLama As Integer) As Boolean

Dim MaTriKs As MaTRikS_TanImlanmaSi
Dim SAtir As Integer, KoLon As Integer
Dim YazdirilaN_Satir As String

MaTriKs.BoyuT_Sayisi = MaTriKs_BoyUtu(MaTriks_Adi)

If MaTriKs.BoyuT_Sayisi < 1 Then
MsgBox "Bu bir matriks değildir.", vbCritical + vbOKOnly, "HATA"
MatriKs_YazDir = False
Exit Function
End If

MaTriKs.SatiR_Sayisi = UBound(MaTriks_Adi, 1)

On Error GoTo HATA

If MaTriKs.BoyuT_Sayisi < 2 Then

For SAtir = 1 To MaTriKs.SatiR_Sayisi Step 1

If IsNull(YuvarLama) = True Then
YazdirilaN_Satir = YazdirilaN_Satir & Space(10) & CStr(MaTriks_Adi(SAtir))
Else
YazdirilaN_Satir = YazdirilaN_Satir & Space(10) & CStr(Round(MaTriks_Adi(SAtir), YuvarLama))
End If

YazdirilaN_Satir = YazdirilaN_Satir & Chr(13) & Chr(13)
Next SAtir

Else
MaTriKs.Kolon_Sayisi = UBound(MaTriks_Adi, 2)

For SAtir = 1 To MaTriKs.SatiR_Sayisi Step 1

For KoLon = 1 To MaTriKs.Kolon_Sayisi Step 1

If IsNull(YuvarLama) = True Then
YazdirilaN_Satir = YazdirilaN_Satir & Space(10) & MaTriks_Adi(SAtir, KoLon)
Else
YazdirilaN_Satir = YazdirilaN_Satir & Space(10) & Round(MaTriks_Adi(SAtir, KoLon), YuvarLama)
End If

Next KoLon

YazdirilaN_Satir = YazdirilaN_Satir & Chr(13) & Chr(13)
Next SAtir

End If


MsgBox YazdirilaN_Satir, , BasliK
MatriKs_YazDir = True

Exit Function

HATA:
MsgBox "Beklenmeyen bir hata oluştu. Lütfen Programı kapatıp bir daha çalıştırın.", vbCritical + vbOKOnly, "HATA"
MatriKs_YazDir = False

End Function

__________________