Private Sub CommandButton1_Click()
Dim A() As Integer
Dim B() As Integer
Dim R() As Integer
myi1 = InputBox("Введите количество строк матрицы A")
myj1 = InputBox("Введите количество стробцов матрицы A")
ReDim A(myi1, myj1)
For i1 = 1 To myi1
For j1 = 1 To myj1
A(i1, j1) = InputBox("Введите A(" & i1 & "," & j1 & ")")
Next j1
Next i1
myi2 = InputBox("Введите количество строк матрицы В ")
myj2 = InputBox("Введите количество стролбцов матрицы В ")
ReDim B(myi2, myj2)
For i2 = 1 To myi2
For j2 = 1 To myj2
B(i2, j2) = InputBox("Введите B(" & i2 & "," & j2 & ")")
Next j2
Next i2
If (myj1 = myi2) Then
'тело умножения
For i = 1 To myi1
For j = 1 To myj2
R(i, j) = 0
For k = 1 To myj1
R(i, j) = R(i, j) + A(i, k) * B(k, j)
Next k
Next j
Next i
Else
MsgBox ("Невозможно перемножить матрицы")
End If
End Sub
Kram1k, почитать про матрицы и другие разделы математики всё-таки стоит иначе незачем заниматься программированием. Привожу текст для вашего случая, хотя процедуру Umno можно сделать с параметрами Umno(N,M), где M, N размерности матриц. Burk
| Visual Basic | ||
|
Добавлено через 53 минуты
Kram1k, я только что обратил внимание, что надо умножить В на А (или всё равно???). Если нет, то переставить 4 и 5, а вместо .Cells(i,k) поставить .Cells(6+i,k), вместо .Cells(k,6+j) поставить .Cells(k,j). Да, и поменьше пользуйтесь калькулятором, лучше головой. Burk
Решение систем линейных уравнений, умножение и обращение матриц
Задачи, перечисленные в заголовке, возникают достаточно часто в различных сферах деятельности, требующих применения математического аппарата. По этой причине в библиотеке Excel есть встроенные функции, позволяющие решить эти задачи. О встроенных функциях умножения матриц МУМНОЖ (MMULT) и транспонирования матриц МТРАНСП (MTRANSP) я уже упоминал, есть и функция для нахождения обратной матрицы — МОБРАТ (MINVERSE). Зная обратную матрицу и умея умножать матрицы, найти решение системы уравнений не представляет труда. Но поскольку умение решать эти задачи входит в круг начального образования программиста, то я полагаю уместным рассмотреть создание собственных аналогов этих функций на VBA. Заодно это позволит рассмотреть некоторые важные моменты в создании пользовательских функций, вызываемых в формулах рабочего листа. Многое мы уже знаем. Знаем, как написать пользовательскую функцию, какие ограничения накладываются на ее параметры с тем, чтобы ее можно было вызывать из
формул рабочего листа Excel, передавая ей в качестве фактических параметров массивы рабочего листа. Знаем, как анализировать тип переданных данных. Знаем, как такая функция может вернуть массив и изменить содержимое рабочего листа. В последующих примерах я еще раз коснусь всех этих вопросов, а, кроме того, появятся и другие вопросы, на которые стоит обратить внимание.
Задача 11 Произведение матриц
Постановка задачи: Найти произведение прямоугольных матриц A*B
Из того, что мы узнали ранее, следует, какой вид может иметь заголовок пользовательской функции, решающей эту задачу. Два входных параметра функции должны быть типа Variant. Этот же тип должен быть у возвращаемого функцией значения. Конечно, это не единственно возможное решение. Можно было бы иметь один входной параметр, используя спецификатор ParamArray. Такой способ был бы единственно возможным, если обобщить постановку и попытаться создать функцию, которая должна перемножать произвольное число матриц. Но при умножении двух матриц естественнее иметь и два соответствующих им параметра. Поэтому заголовок получился таким:
Function MultMatr(A As Variant, B As Variant) As Variant
Я хочу показать Вам, как написать общую функцию, достаточно широкого назначения. Ее можно будет вызывать в формулах над массивами рабочего листа, передавая ей в качестве фактических параметров A и B массивы рабочего листа (объекты Range ). Но не только объекты Range, но и массивы констант будут допускаться в качестве одного или обоих аргументов. Результат работы функции будет записан в массив, выделенный в момент вызова формулы над массивами. Более того, я хочу, чтобы эту же функцию можно было вызывать в обычных функциях и процедурах VBA, передавая в момент вызова массивы VBA в качестве аргументов. Все это, естественно, утяжелит нашу функцию, но позволит мне обсудить отличия «обычных» и «пользовательских функций. С учетом этих замечаний наша функция выглядит так:
Public Function MultMatr(A As Variant, B As Variant) As Variant 'Умножение матриц. 'Эта функция может вызываться в формулах рабочего листа Excel. 'В этом случае входные параметры являются объектами Range. 'Функцию можно также вызывать в обычных VBA функциях и процедурах, 'передавая ей в качестве параметров массивы VBA. Dim AB() As Variant Dim i As Integer, j As Integer, k As Integer Dim N As Integer, M As Integer, P As Integer, Q As Integer Dim Correct As Boolean Dim msg1 As String, msg2 As String Dim Elem As Variant Correct = True 'Определение размерностей матриц If TypeName(A) = "Range" Then N = A.Rows.Count: M = A.Columns.Count ElseIf TypeName(A) = "Variant()" Then N = UBound(A, 1): M = UBound(A, 2) Else: Correct = False End If If TypeName(B) = "Range" Then P = B.Rows.Count: Q = B.Columns.Count ElseIf TypeName(A) = "Variant()" Then P = UBound(B, 1): Q = UBound(B, 2) Else: Correct = False End If 'Проверка корректности задания размерности If Correct And (P = M) Then 'Размерность задана корректно ReDim AB(1 To N, 1 To Q) 'Построение произведения матриц AB =A*B For i = 1 To N For j = 1 To Q Elem = 0 For k = 1 To M Elem = Elem + A(i, k) * B(k, j) Next k AB(i, j) = Elem Next j Next i MultMatr = AB Else 'Некорректно заданы аргументы или размерность If Not Correct Then msg2 = " При вызове MultMatr некорректно заданы аргументы!" _ & vbCrLf & "По крайней мере, один из них не является" _ & vbCrLf & "ни массивом, ни объектом Range" MsgBox (msg2) Else msg1 = " При вызове MultMatr некорректно задана размерность" _ & " перемножаемых матриц!" & vbCrLf & _ "Число столбцов в первом сомножителе = " & M & vbCrLf & _ "Число строк второго сомножителя = " & P MsgBox (msg1) End If End If End Function
Сделаем несколько замечаний.
- Из-за того, что фактические параметры могут иметь разную природу, приходится анализировать тип параметра, используя уже упоминавшуюся функцию TypeName.
- В зависимости от того, массивом или объектом Range является параметр, по-разному определяются границы массивов.
- Если хотя бы один из аргументов не принадлежит ни одному из перечисленных типов, вычисления прерываются с выдачей предупреждающего сообщения.
- Еще одна проверка, которую я счел обязательной, — проверка на корректность задания размеров перемножаемых матриц. Конечный пользователь может легко ошибиться и не соблюсти обязательное требование при умножении матриц: «число столбцов матрицы A должно совпадать с числом строк матрицы B «. В этом случае результат не будет получен, и будет выдано предупреждающее сообщение. Если же пользователь неверно выделит область памяти под результирующую матрицу, вычисления будут идти. Правда, если эта область урезана по отношению к требуемой, часть результатов будет потеряна. Если же область выделена с избытком, выводятся «лишние» результаты, полученные путем копирования.
- Заметьте, сам процесс вычисления результирующей матрицы выполняется одинаково для обоих типов аргументов.
- Результат получается в динамическом массиве, который на последнем шаге работы и становится значением функции.
- Функцию MultMatr я использовал двояко, — вызывая ее в формулах над массивами в рабочем листе Excel и в обычной процедуре VBA, когда мне понадобилось получить произведение двух матриц, представленных обычными массивами VBA.
Взгляните, как выглядят результаты некоторых экспериментов по умножению матриц на рабочем листе Excel:
На рабочем листе я расположил три матрицы разной размерности и дал им имена MatrA, MatrB и MatrC соответственно. Затем, вызывая MultMatr, я получил произведения MatrA*MatrB и MatrB*MatrC, — все выполнилось корректно. Попытка использовать MultMatr для умножения массива констант на матрицу — {1,2; 2,3}*MatrC закончилась неуспехом, поскольку, как я говорил ранее, для массивов констант некорректно работает функция Ubound. При попытке умножения MatrA*MatrC, как и положено, выдалось предупреждающее сообщение о несоблюдении правила размерности перемножаемых матриц.
«Пользовательские» и «обычные» функции VBA
Под пользовательской функцией VBA я понимаю функцию, которая может быть вызвана в формулах рабочего листа Excel. Обычные функции VBA могут вызываться в функциях и процедурах VBA. Возникает естественный вопрос, может ли одна и та же функция одновременно быть пользовательской и обычной? Этот же вопрос может быть сформулирован и по-другому, есть ли особая специфика в пользовательских функциях? Ответ прост — особой специфики нет, и одна и та же функция может вызываться как в формулах, так и в процедурах VBA. Практически не возникает проблем, когда аргументами функции и результатом являются скалярные значения. Когда же, как в случае с MultMatr, аргументами и результатом являются массивы, то возникают определенные трудности. Эти трудности преодолимы, примером тому служит функция MultMatr. Попробуем разобраться, в чем состоят эти трудности. Когда функции нужно предать массив, то в пользовательских функциях при вызове им передаются объекты Range, обычным функциям — пер
еменные, описанные, как массивы VBA. Поэтому для обеспечения универсального характера функции в ее теле необходимо производить разбор случаев, определяя тип параметра. В результате растет объем функции, а, следовательно, усложняется ее понимание. Еще одна сложность связана с результатом вычислений. Никаких проблем нет для формулы над массивами, вызывающей пользовательскую функцию, — результат, записывается в область, выделенную при вызове формулы. Обычные функции VBA, как правило, не возвращают массив в качестве результата. Если результатом работы является массив, то при программировании на VBA создается процедура, а не функция. Дело в том, что в VBA присваивания над массивами запрещены, потому просто невозможно присвоить массиву значение обычной функции, возвращающей массив в качестве своего результата. Как же, спросите Вы, MultMatr может использоваться в качестве обычной функции? Только за счет маленьких хитростей и универсального типа Variant, который может быть чем угодно, в том числе и массивом. При вызове MultMatr как обычной функции в процедуре VBA результат вызова присваивается переменной типа Variant, — это допустимо. Затем уже с этой переменной можно работать как с массивом, — это тоже допустимо, что я и продемонстрирую чуть позже. Таким образом, всегда можно написать функцию так, чтобы она служила и как пользовательская и как обычная функция. Другой вопрос, стоит ли это делать. В таком обобщении есть свой резон, поскольку в таких случаях при вызове пользовательской функции ей можно передавать в качестве аргументов не только объекты Range, но и массивы констант, что было продемонстрировано при рассмотрении функции IsMedianaForAll. Заметьте, однако, что в функцию MultMatr передать массивы констант невозможно. Причина этого в том, что для двумерных массивов констант функции UBound и LBound работают некорректно.
Подводя итог, замечу, что, когда приходится работать с массивами, разумнее иметь два варианта — пользовательскую и обычную функцию. Чтобы отчетливее продемонстрировать разницу между обычными и пользовательскими функциями, я написал обычную процедуру MultMatr1, выполняющую умножение матриц. Вот ее текст:
Public Sub MultMatr1(A() As Variant, B() As Variant, C() As Variant) 'Умножение матриц. 'Процедуру можно вызывать в обычных VBA функциях и процедурах, 'передавая ей в качестве параметров массивы VBA. Dim i As Integer, j As Integer, k As Integer Dim N As Integer, M As Integer, Q As Integer Dim P As Integer, NC As Integer, PC As Integer Dim msg1 As String, msg2 As String Dim Uncor1 As Boolean, Uncor2 As Boolean Dim Elem As Variant Uncor1 = True: Uncor2 = True msg1 = " При вызове MultMatr некорректно задана размерность" _ & " перемножаемых матриц!" & vbCrLf & _ "Число столбцов матрицы A = " & M & vbCrLf & _ "Число строк матрицы B = " & Q msg2 = " При вызове MultMatr некорректно задана размерность" _ & " матрицы результата!" & vbCrLf & _ "Число строк матрицы C = " & NC & vbCrLf & _ "Число столбцов матрицы C = " & PC 'Проверка корректности задания размерности N = UBound(A, 1): M = UBound(A, 2) Q = UBound(B, 1): P = UBound(B, 2) NC = UBound(C, 1): PC = UBound(C, 2) If (Q = M) Then 'Размерность исходных матриц задана корректно Uncor1 = False If NC = N And PC = P Then 'Размерность результата задана корректно Uncor2 = False 'Построение произведения матриц AB =A*B For i = 1 To N For j = 1 To P Elem = 0 For k = 1 To M Elem = Elem + A(i, k) * B(k, j) Next k C(i, j) = Elem Next j Next i Else 'некорректно задана размерность If Uncor1 Then MsgBox (msg1) If Uncor2 Then MsgBox (msg2) End If End If End Sub
От функции MultMatr она отличается тем, что в ней опущен разбор случаев и проводится более тщательная проверка корректности размерностей аргументов. Конечно, она ни в коем случае не может быть использована как пользовательская функция, но зато работать с ней в процедурах и функциях VBA с ней не то чтобы проще, но естественнее. Чтобы почувствовать разницу, я продемонстрирую тестовую процедуру, в которой вызываются, как функция MultMatr так и процедура MultMatr1.
Public Sub MultTest() Dim A(1 To 2, 1 To 2) As Variant Dim B(1 To 2, 1 To 2) As Variant Dim C(1 To 2, 1 To 2) As Variant Dim C1 As Variant Dim item As Variant Dim i As Integer, j As Integer A(1, 1) = 1: A(1, 2) = 2: A(2, 1) = 3: A(2, 2) = 4 B(1, 1) = 1: B(1, 2) = 2: B(2, 1) = 3: B(2, 2) = 4 'Переменной типа Variant присваивается массив C1 = MultMatr(A, B) For i = 1 To UBound(C1, 1) For j = 1 To UBound(C1, 2) Debug.Print C1(i, j) Next j Next i 'Здесь С - массив и работаем с ним, как с массивом. Call MultMatr1(A, B, C) For i = 1 To UBound(C, 1) For j = 1 To UBound(C1, 2) Debug.Print C(i, j) Next j Next i 'Вызов тестовой функции, возвращающей массив. C1 = ResArray(A) For Each item In C1 Debug.Print item Next item End Sub Public Function ResArray(A() As Variant) As Variant 'Возвращает в качестве результата, 'переданный ей массив ResArray = A End Function
Как видите, функция MultMatr, успешно работающая в роли пользовательской функции, с тем же успехом может выполнять и роль обычной функции. Так что я выполнил поставленную задачу, создав «универсальную» функцию. Но, возможно, предпочтительнее в процедурах VBA работать с MultMatr1, не прибегая к переменным типа Variant. Обратите внимание на небольшую тестовую функцию ResArray, которую я написал, чтобы в явной форме продемонстрировать способ возвращения массива в функциях VBA.
The Matrix
Since my knowledge about matrices doesn’t extend beyond the three sentences in the first image, use any of it with caution.
Matrix Multiplication (Wikipedia)
Excel — MMULT
Sheet1
For the left example copy the following formula into cell H2:
=MMULT(A2:C3,E2:F4)
Now select cell H2 and extend the range to I3 getting range H2:I3 selected with cell H2 active (its color is white while the other cells are gray). Click into the formula bar and confirm using CTRL+SHIFT+ENTER. When you look in the formula bar, each of the four cells (visually) have the same formula:
{=MMULT(A2:C3,E2:F4)}
where the braces ({ and }) only indicate that this is an array formula. The braces have been automatically added, do not try to add them manually.
For the right example copy the following formula into cell R7:
=MMULT(N2:P5,R2:V4)
Now select cell R7 and extend the range to V10 getting range R7:V10 selected with cell R7 active (its color is white while the other cells are gray). Click into the formula bar and confirm using CTRL+SHIFT+ENTER. When you look in the formula bar, each of the twenty cells (visually) have the same formula:
{=MMULT(N2:P5,R2:V4)}
where the braces ({ and }) only indicate that this is an array formula. The braces have been automatically added, do not try to add them manually.
Sheet2
According to your code, you can use the following formula in cell H28:
=MMULT(A28:C29,E28:F30)
Now select cell H28 and extend the range to I29 getting range H28:I29 selected with cell H28 active (its color is white while the other cells are gray). Click into the formula bar and confirm using CTRL+SHIFT+ENTER. When you look in the formula bar, each of the four cells (visually) have the same formula:
{=MMULT(A28:C29,E28:F30)}
where the braces ({ and }) only indicate that this is an array formula. The braces have been automatically added, do not try to add them manually.
VBA
Adjust the constants as you see fit.
Option Explicit
' The Sub Solutions
' Sub Version (No Functions Used)
Sub writeMatrixProductSub()
Const Sheet As String = "Sheet2"
Const rngM1 As String = "A28:C29"
Const rngM2 As String = "E28:F30"
Const celMP As String = "H28"
Dim M1, M2, MP, Row1 As Long, Col1Row2 As Long, Col2 As Long, Curr As Double
' Read from worksheet and write to arrays.
With ThisWorkbook.Worksheets(Sheet)
M1 = .Range(rngM1)
M2 = .Range(rngM2)
End With
' Calculate in arrays.
If UBound(M1, 2) <> UBound(M2) Then Exit Sub
ReDim MP(1 To UBound(M1), 1 To UBound(M2, 2))
For Col2 = 1 To UBound(M2, 2)
For Row1 = 1 To UBound(M1)
For Col1Row2 = 1 To UBound(M1, 2)
Curr = Curr + M1(Row1, Col1Row2) * M2(Col1Row2, Col2)
Next Col1Row2
MP(Row1, Col2) = Curr: Curr = 0
Next Row1
Next Col2
' Check values of Matrix Product in Immediate window.
' For Row1 = 1 To UBound(MP)
' For Col1Row2 = 1 To UBound(MP, 2)
' Debug.Print MP(Row1, Col1Row2)
' Next
' Next
' Write to worksheet.
With ThisWorkbook.Worksheets(Sheet)
.Range(celMP).Resize(UBound(MP), UBound(MP, 2)) = MP
End With
End Sub
' Sub Version Using "WorksheetFunction.MMult" with qualified worksheet
Sub writeMatrixProductMMultSubQualify()
Const Sheet As String = "Sheet2"
Const rngM1 As String = "A28:C29"
Const rngM2 As String = "E28:F30"
Const celMP As String = "H28"
Dim M1, M2, MP
With ThisWorkbook.Worksheets(Sheet)
M1 = .Range(rngM1)
M2 = .Range(rngM2)
If UBound(M1, 2) <> UBound(M2) Then Exit Sub
ReDim MP(1 To UBound(M1), 1 To UBound(M2, 2))
MP = WorksheetFunction.MMult(M1, M2)
.Range(celMP).Resize(UBound(MP), UBound(MP, 2)) = MP
End With
End Sub
' Sub Version Using "WorksheetFunction.MMult"
Sub writeMatrixProductMMultSub()
Const rngM1 As String = "A28:C29"
Const rngM2 As String = "E28:F30"
Const celMP As String = "H28"
Dim M1, M2, MP
M1 = Range(rngM1)
M2 = Range(rngM2)
If UBound(M1, 2) <> UBound(M2) Then Exit Sub
ReDim MP(1 To UBound(M1), 1 To UBound(M2, 2))
MP = WorksheetFunction.MMult(M1, M2)
Range(celMP).Resize(UBound(MP), UBound(MP, 2)) = MP
End Sub
' The Function Solutions
' Sub Using "writeMatrixProduct" and "getMatrixProduct1"
Sub testMatrixProductSimple()
Const rngM1 As String = "A28:C29"
Const rngM2 As String = "E28:F30"
Const celMP As String = "H28"
writeMatrixProduct Range(rngM1), Range(rngM2), Range(celMP)
End Sub
' Sub Using "writeMatrixProduct" and "getMatrixProduct1" with Checking
Sub testMatrixProductCheck()
Const rngM1 As String = "A28:C29"
Const rngM2 As String = "E28:F30"
Const celMP As String = "H28"
Dim Success As Boolean
Success = writeMatrixProduct(Range(rngM1), Range(rngM2), Range(celMP))
If Success Then
MsgBox "Write was successful.", vbInformation
Else
MsgBox "Write was unsuccessful. Nothing written.", vbExclamation
End If
End Sub
' The Functions
' Remarks: 2D 1-based is convenient for operating in ranges.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Using the "getMatrixProduct1" function, writes the matrix '
' product of two matrices contained in ranges to another range. '
' Returns: A boolean indicating if the operation was successful. '
' Remarks: The resulting range is specified only by its first cell. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function writeMatrixProduct(Matrix1 As Range, Matrix2 As Range, _
MatrixProductFirstCell As Range) As Boolean
Dim M1, M2, MP
On Error GoTo handleError
M1 = Matrix1: M2 = Matrix2
MP = getMatrixProduct1(M1, M2)
If Not IsArray(MP) Then Exit Function
MatrixProductFirstCell.Resize(UBound(MP), UBound(MP, 2)) = MP
writeMatrixProduct = True
exitProcedure:
Exit Function
handleError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume exitProcedure
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns a 2D 1-based array containing the matrix product '
' of two matrices contained in 2D 1-based arrays. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function getMatrixProduct1(Matrix1 As Variant, Matrix2 As Variant) As Variant
If UBound(Matrix1, 2) <> UBound(Matrix2) Then Exit Function
Dim MP, Row1 As Long, Col1Row2 As Long, Col2 As Long, Curr As Double
ReDim MP(1 To UBound(Matrix1), 1 To UBound(Matrix2, 2))
For Col2 = 1 To UBound(Matrix2, 2)
For Row1 = 1 To UBound(Matrix1)
For Col1Row2 = 1 To UBound(Matrix1, 2)
Curr = Curr + Matrix1(Row1, Col1Row2) * Matrix2(Col1Row2, Col2)
Next Col1Row2
MP(Row1, Col2) = Curr: Curr = 0
Next Row1
Next Col2
getMatrixProduct1 = MP
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns a 2D 1-based array containing the matrix product '
' of two matrices contained in 2D 1-based arrays. '
' Remarks: While testing it turned out to be over 10 times slower than '
' the "getMatrixProduct1" function (needs to be verified). '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function getMatrixProduct1M(Matrix1 As Variant, Matrix2 As Variant) As Variant
If UBound(Matrix1, 2) <> UBound(Matrix2) Then Exit Function
Dim MP: ReDim MP(1 To UBound(Matrix1), 1 To UBound(Matrix2, 2))
MP = WorksheetFunction.MMult(Matrix1, Matrix2): getMatrixProduct1M = MP
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Матрица
Поскольку мои знания о матрицах не выходят за рамки трех предложений на первом изображении, используйте их с осторожностью.
Умножение матриц (Википедия)
Excel — MMULT
Лист1
В левом примере скопируйте следующую формулу в ячейку H2:
=MMULT(A2:C3,E2:F4)
Теперь выберите ячейку H2 и расширить диапазон до I3 получение диапазона H2:I3 выделено ячейкой H2 активный (его цвет white в то время как другие ячейки gray). Щелкните строку формул и подтвердите, нажав CTRL+SHIFT+ENTER. Когда вы смотрите на строку формул, каждая из четырех ячеек (визуально) содержит одну и ту же формулу:
{=MMULT(A2:C3,E2:F4)}
где фигурные скобки ({ а также }) указывают только на то, что это формула массива. Подтяжки добавлены автоматически, не пытайтесь добавлять их вручную.
Для правильного примера скопируйте следующую формулу в ячейку R7:
=MMULT(N2:P5,R2:V4)
Теперь выберите ячейку R7 и расширить диапазон до V10 получение диапазона R7:V10 выделено ячейкой R7 активный (его цвет white в то время как другие ячейки gray). Щелкните строку формул и подтвердите, нажав CTRL+SHIFT+ENTER. Когда вы смотрите на строку формул, каждая из двадцати ячеек (визуально) имеет одну и ту же формулу:
{=MMULT(N2:P5,R2:V4)}
где фигурные скобки ({ а также }) указывают только на то, что это формула массива. Подтяжки добавлены автоматически, не пытайтесь добавлять их вручную.
Лист2
Согласно вашему коду вы можете использовать следующую формулу в ячейке H28:
=MMULT(A28:C29,E28:F30)
Теперь выберите ячейку H28 и расширить диапазон до I29 получение диапазона H28:I29 выделено ячейкой H28 активный (его цвет white в то время как другие ячейки gray). Щелкните строку формул и подтвердите, нажав CTRL+SHIFT+ENTER. Когда вы смотрите на строку формул, каждая из четырех ячеек (визуально) содержит одну и ту же формулу:
{=MMULT(A28:C29,E28:F30)}
где фигурные скобки ({ а также }) указывают только на то, что это формула массива. Подтяжки добавлены автоматически, не пытайтесь добавлять их вручную.
VBA
Отрегулируйте константы по своему усмотрению.
Option Explicit
' The Sub Solutions
' Sub Version (No Functions Used)
Sub writeMatrixProductSub()
Const Sheet As String = "Sheet2"
Const rngM1 As String = "A28:C29"
Const rngM2 As String = "E28:F30"
Const celMP As String = "H28"
Dim M1, M2, MP, Row1 As Long, Col1Row2 As Long, Col2 As Long, Curr As Double
' Read from worksheet and write to arrays.
With ThisWorkbook.Worksheets(Sheet)
M1 = .Range(rngM1)
M2 = .Range(rngM2)
End With
' Calculate in arrays.
If UBound(M1, 2) <> UBound(M2) Then Exit Sub
ReDim MP(1 To UBound(M1), 1 To UBound(M2, 2))
For Col2 = 1 To UBound(M2, 2)
For Row1 = 1 To UBound(M1)
For Col1Row2 = 1 To UBound(M1, 2)
Curr = Curr + M1(Row1, Col1Row2) * M2(Col1Row2, Col2)
Next Col1Row2
MP(Row1, Col2) = Curr: Curr = 0
Next Row1
Next Col2
' Check values of Matrix Product in Immediate window.
' For Row1 = 1 To UBound(MP)
' For Col1Row2 = 1 To UBound(MP, 2)
' Debug.Print MP(Row1, Col1Row2)
' Next
' Next
' Write to worksheet.
With ThisWorkbook.Worksheets(Sheet)
.Range(celMP).Resize(UBound(MP), UBound(MP, 2)) = MP
End With
End Sub
' Sub Version Using "WorksheetFunction.MMult" with qualified worksheet
Sub writeMatrixProductMMultSubQualify()
Const Sheet As String = "Sheet2"
Const rngM1 As String = "A28:C29"
Const rngM2 As String = "E28:F30"
Const celMP As String = "H28"
Dim M1, M2, MP
With ThisWorkbook.Worksheets(Sheet)
M1 = .Range(rngM1)
M2 = .Range(rngM2)
If UBound(M1, 2) <> UBound(M2) Then Exit Sub
ReDim MP(1 To UBound(M1), 1 To UBound(M2, 2))
MP = WorksheetFunction.MMult(M1, M2)
.Range(celMP).Resize(UBound(MP), UBound(MP, 2)) = MP
End With
End Sub
' Sub Version Using "WorksheetFunction.MMult"
Sub writeMatrixProductMMultSub()
Const rngM1 As String = "A28:C29"
Const rngM2 As String = "E28:F30"
Const celMP As String = "H28"
Dim M1, M2, MP
M1 = Range(rngM1)
M2 = Range(rngM2)
If UBound(M1, 2) <> UBound(M2) Then Exit Sub
ReDim MP(1 To UBound(M1), 1 To UBound(M2, 2))
MP = WorksheetFunction.MMult(M1, M2)
Range(celMP).Resize(UBound(MP), UBound(MP, 2)) = MP
End Sub
' The Function Solutions
' Sub Using "writeMatrixProduct" and "getMatrixProduct1"
Sub testMatrixProductSimple()
Const rngM1 As String = "A28:C29"
Const rngM2 As String = "E28:F30"
Const celMP As String = "H28"
writeMatrixProduct Range(rngM1), Range(rngM2), Range(celMP)
End Sub
' Sub Using "writeMatrixProduct" and "getMatrixProduct1" with Checking
Sub testMatrixProductCheck()
Const rngM1 As String = "A28:C29"
Const rngM2 As String = "E28:F30"
Const celMP As String = "H28"
Dim Success As Boolean
Success = writeMatrixProduct(Range(rngM1), Range(rngM2), Range(celMP))
If Success Then
MsgBox "Write was successful.", vbInformation
Else
MsgBox "Write was unsuccessful. Nothing written.", vbExclamation
End If
End Sub
' The Functions
' Remarks: 2D 1-based is convenient for operating in ranges.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Using the "getMatrixProduct1" function, writes the matrix '
' product of two matrices contained in ranges to another range. '
' Returns: A boolean indicating if the operation was successful. '
' Remarks: The resulting range is specified only by its first cell. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function writeMatrixProduct(Matrix1 As Range, Matrix2 As Range, _
MatrixProductFirstCell As Range) As Boolean
Dim M1, M2, MP
On Error GoTo handleError
M1 = Matrix1: M2 = Matrix2
MP = getMatrixProduct1(M1, M2)
If Not IsArray(MP) Then Exit Function
MatrixProductFirstCell.Resize(UBound(MP), UBound(MP, 2)) = MP
writeMatrixProduct = True
exitProcedure:
Exit Function
handleError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume exitProcedure
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns a 2D 1-based array containing the matrix product '
' of two matrices contained in 2D 1-based arrays. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function getMatrixProduct1(Matrix1 As Variant, Matrix2 As Variant) As Variant
If UBound(Matrix1, 2) <> UBound(Matrix2) Then Exit Function
Dim MP, Row1 As Long, Col1Row2 As Long, Col2 As Long, Curr As Double
ReDim MP(1 To UBound(Matrix1), 1 To UBound(Matrix2, 2))
For Col2 = 1 To UBound(Matrix2, 2)
For Row1 = 1 To UBound(Matrix1)
For Col1Row2 = 1 To UBound(Matrix1, 2)
Curr = Curr + Matrix1(Row1, Col1Row2) * Matrix2(Col1Row2, Col2)
Next Col1Row2
MP(Row1, Col2) = Curr: Curr = 0
Next Row1
Next Col2
getMatrixProduct1 = MP
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose: Returns a 2D 1-based array containing the matrix product '
' of two matrices contained in 2D 1-based arrays. '
' Remarks: While testing it turned out to be over 10 times slower than '
' the "getMatrixProduct1" function (needs to be verified). '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function getMatrixProduct1M(Matrix1 As Variant, Matrix2 As Variant) As Variant
If UBound(Matrix1, 2) <> UBound(Matrix2) Then Exit Function
Dim MP: ReDim MP(1 To UBound(Matrix1), 1 To UBound(Matrix2, 2))
MP = WorksheetFunction.MMult(Matrix1, Matrix2): getMatrixProduct1M = MP
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''