Excel (VBA) - funkce na součet matic

[Gerill]

Zdravim,

potřeboval bych napsat ve VBA funkci, která bude sčítat 2 matice. Věděl by někdo, jak na to?

[Reklama]

[Poki]

Zdravim,
myslim, ze neni nutne psat vlastni funkci - staci pouzit maticoveho vzorce.
Mate-li tedy napr. jednu matici v A1:C3 a druhou v E1:G3, pak tedy staci oznacit odpovidajici oblast -stejny pocet radku a sloupcu, jako scitane matice (napr. B6:D8) a do radku vzorcu napsat vzorec =A1:C3+E1:G3 a ukoncit ho stiskem CTRL+SHIFT+ENTER (maticovy vzorec).

[Gerill]

O tomhle řešení vím, ale i tak to potřebuji napsat jako funkci.

[navstevnik]

Upraveno: koukni se na http://www.thecodenet.com/articles.php?id=8 a pripadne si najdi dalsi

[Gerill]

Díky za odkaz. Koukal jsem na to, ale bohužel z toho moc moudrý nejsem :(. Jestli to chápu správně, potřebuju funkci, která vezme hodnotu po hodnotě z oblasti 1 a sečte s hodnotami v oblasti 2... Snažil jsem se to prozkoumat, ale nic jsem tam nenašel. Nebylo by něco více konkrétnějšího?

[navstevnik]

Prostudovanim prilozeneho odkazu a souboru v odkazu bys nasel reseni uzivatelske funkce pro soucet matic.

Ve standardnim modulu je vlozena funkce realizujici soucet matic:

Kód: Vybrat vše

Option Explicit

Public Function SoucetMatic(Matice1 As Range, Matice2 As Range) As Variant()
  Dim Mt1() As Variant, Mt2() As Variant
  Dim r As Integer, c As Integer
  Dim temp() As Variant
  ' vlozeni hodnot matic do poli Mt
  Mt1 = Matice1.Value
  Mt2 = Matice2.Value
  ' kontrola shody rozmeru matic
  If UBound(Mt1) = UBound(Mt2) And UBound(Mt1, 2) = UBound(Mt2, 2) Then
    ' redefinice pole temp() podle rozmeru vstupnich matic
    ReDim temp(LBound(Mt1) To UBound(Mt1), _
        LBound(Mt1, 2) To UBound(Mt1, 2))
    ' smycka po radcich a sloupcich,
    ' vlozeni souctu do pole temp()
    For r = LBound(Mt1) To UBound(Mt1)
      For c = LBound(Mt1, 2) To UBound(Mt1, 2)
        temp(r, c) = Mt1(r, c) + Mt2(r, c)
      Next c
    Next r
    SoucetMatic = temp()
  Else
    Exit Function
  End If
End Function

Na listu jsou dany dve matice shodne rozmerem, vyberes novy blok bunek o shodnem rozmeru a v editacnim radku rovnic vlozis funkci (priklad): =SoucetMatic(A1:B4;D1:E4) a zadas maticove - Ctrl+Shift+Enter
Pokud vysledkova matice bude zadana rozmerove odlisne, bude v prebyvajicich bunkach hodnota #N/A

[Gerill]

Díky moc, funguje to tak jak má. Akorát si tam přidám ošetření, aby nebyly v matici prázdné buňky.

jen jeden malej dotaz:

Kód: Vybrat vše

Public Function SoucetMatic(Matice1 As Range, Matice2 As Range) As Variant()

co znamenají ty závorky na konci u datového typu? Když jsem to zkoušel bez nich, tak se nevyhodila chyba hodnoty pokud matice neměly stejný rozměr, ale byly všude nuly.

[navstevnik]

Prazdne bunky se chovaji jako bunky obsahujici 0 (nulu), takze neni z matematickeho hlediska nutne zadne opatreni.
Deklarace typu vystupu - Variant() zajistuje navratovy typ: pole datoveho typu variant. Funkce musi vracet pole a protoze se jedna o funkci Array (je zadavana maticove), je nutny pro naplneni tohoto pole typ Variant.
V pripade chyby v behu funkce nebo neshody matic je v pripade, kdy neni deklarovan (nebo jen Variant) navratovy typ, je vracena 0 (nula).

Doplneno: Muzes poexperimentovat, z funkce vypustit kontrolu rozmeru matic a pro rozmery pole temp pouzit mensi rozmery vstupnich matic.

[Gerill]

Tak nakonec bych potřeboval ještě jednu věc. Potřebuji v projektu 2 funkce, jednu řekněme hlavní a jednu vedlejší. Ta vedlejší se má v té hlavní volat.

napadlo mě vzít vše co následuje po:

Kód: Vybrat vše

If UBound(Mt1) = UBound(Mt2) And UBound(Mt1, 2) = UBound(Mt2, 2) Then

tudíž:

Kód: Vybrat vše

  ' redefinice pole temp() podle rozmeru vstupnich matic
    ReDim temp(LBound(Mt1) To UBound(Mt1), _
        LBound(Mt1, 2) To UBound(Mt1, 2))
    ' smycka po radcich a sloupcich,
    ' vlozeni souctu do pole temp()
    For r = LBound(Mt1) To UBound(Mt1)
      For c = LBound(Mt1, 2) To UBound(Mt1, 2)
        temp(r, c) = Mt1(r, c) + Mt2(r, c)
      Next c
    Next r
    SoucetMatic = temp()

a z toho udělat samostatnou funkci, kterou poté v tomu ifu jen zavolám. Problém je v tom, že nevím jak uchovat ty hodnoty Mt1 a Mt2, aby platily i v té vedlejší funkci.

napsal jsem to takhle, ale nevim s těma proměnnýma Mt1 a Mt2

Kód: Vybrat vše

Private Function ScitaniM() As Variant()

  Dim r As Integer, c As Integer
  Dim vyslPole() As Variant

  ReDim vyslPole(LBound(Mt1) To UBound(Mt1), LBound(Mt1, 2) To UBound(Mt1, 2))
               
    For r = LBound(Mt1) To UBound(Mt1)
      For c = LBound(Mt1, 2) To UBound(Mt1, 2)
           
       vyslPole(r, c) = Mt1(r, c) + Mt2(r, c)
               
     Next c
   Next r
           
    ScitaniM = vyslPole()
   
End Function

byla by i tady nějaká rada? věřim, že je to jen nějaká ptákovina

[navstevnik]

Neni mi jasne, co tim sledujes, co tohle, pokud jsem spravne pochopil (je zapotrebi predavat parametry):

Kód: Vybrat vše

Option Explicit

Public Function SoucetMatic(Matice1 As Range, Matice2 As Range) As Variant()
  Dim Mt1() As Variant, Mt2() As Variant

  ' vlozeni hodnot matic do poli Mt
  Mt1 = Matice1.Value
  Mt2 = Matice2.Value
  ' kontrola shody rozmeru matic
  If UBound(Mt1) = UBound(Mt2) And UBound(Mt1, 2) = UBound(Mt2, 2) Then
    SoucetMatic = ScitaniM(Mt1, Mt2)
  End If
End Function

Private Function ScitaniM(Mt1() As Variant, Mt2() As Variant) As Variant()
  Dim r As Integer, c As Integer
  Dim vyslPole() As Variant

  ReDim vyslPole(LBound(Mt1) To UBound(Mt1), LBound(Mt1, 2) To UBound(Mt1, 2))
  For r = LBound(Mt1) To UBound(Mt1)
    For c = LBound(Mt1, 2) To UBound(Mt1, 2)
      vyslPole(r, c) = Mt1(r, c) + Mt2(r, c)
    Next c
  Next r
  ScitaniM = vyslPole()
End Function

' nasledujici sub slouzi pro moznost krokovani (F8) funkcemi
Sub TestSoucetMatic()
  Dim MtR1 As Range, MtR2 As Range
  Dim SumM() As Variant
 
  Set MtR1 = Range("a1:B4")
  Set MtR2 = Range("d1:e4")
  SumM() = TestMatic(MtR1, MtR2)
End Sub


[Gerill]

díky to je ono...ještě poslední věc, šlo by to nějak upravit, aby to fungovalo i na matice 1x1?

[navstevnik]

Upravit se da, ale nevidim smysl takoveto upravy, je to paslvil, ktery by nemel spatri svetlo sveta:

Kód: Vybrat vše

Option Explicit

Public Function SoucetMatic1(Matice1 As Range, Matice2 As Range) As Variant()
  Dim Mt1() As Variant, Mt2() As Variant
  Dim r As Integer, c As Integer
  Dim temp() As Variant
  If Matice1.Cells.Count = 1 And Matice2.Cells.Count = 1 Then
    ReDim temp(0)
    temp(0) = Matice1.Value + Matice2.Value
    SoucetMatic1 = temp()
  Else
    ' vlozeni hodnot matic do poli Mt
    Mt1 = Matice1.Value
    Mt2 = Matice2.Value
    ' kontrola shody rozmeru matic
    If UBound(Mt1, 1) = UBound(Mt2, 1) And UBound(Mt1, 2) = UBound(Mt2, 2) Then
      ' redefinice pole temp() podle rozmeru vstupnich matic
      ReDim temp(LBound(Mt1, 1) To UBound(Mt1, 1), _
          LBound(Mt1, 2) To UBound(Mt1, 2))
      ' smycka po radcich a sloupcich,
      ' vlozeni souctu do pole temp()
      For r = LBound(Mt1) To UBound(Mt1)
        For c = LBound(Mt1, 2) To UBound(Mt1, 2)
          temp(r, c) = Mt1(r, c) + Mt2(r, c)
        Next c
      Next r
      SoucetMatic1 = temp()
    Else
      Exit Function
    End If
  End If
End Function
Sub TestSoucetMatic1()
  Dim Suma() As Variant
  With Worksheets("list1")
    Suma = SoucetMatic1(.Range("a1"), .Range("d1"))
    Suma = SoucetMatic1(.Range("a1:b4"), .Range("d1:e4"))
  End With
End Sub