Умножьте значения в каждом столбце на вторую ячейку в каждом столбце

Question

У меня есть лист, который содержит: в строке 1: дата, когда контейнеры были проверены в строке 2: средний килограмм на одну плохую в конкретном дне, строка 3 ниже: количество мешков, собранных на каждый контейнер. Моя тестовая таблица имеет диапазон A1: D8

Я пытаюсь скопировать эту таблицу с «Sheet1» на «Sheet2» и в то же время рассчитать, сколько кг каждый контейнер в конкретный день умножил на количество мешки каждого контейнера. Я могу рассчитать ячейки с одним фиксированным значением. Однако я изо всех сил пытаюсь умножить каждый столбец из строки 3 ниже на значение в строке 2.

Private Sub CommandButton1_Click()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim myVal As Range

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set rng = ws2.Range("A3:D8")

Sheets("Sheet1").Range("A3:D8").Copy Destination:=Sheets("Sheet2").Range("A8:D3")

For Each myVal In rng
myVal = myVal.Value * ws1.Range("A1")
Next myVal

End Sub

Answer 1

Насколько я понимаю, это, вероятно, то, что вам нужно:

в следующем коде вместо итерации по каждой ячейке я создам матрицу для выполнения умножения 2 матриц, а затем использую Функция MMULT для возврата результата (см. Мое изображение)

Примечание: Этот подход может быть не очень эффективным, это всего лишь временная мысль.

Sub Test()
Dim ws1 As Worksheet: Set ws1 = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim Rng As Range: Set Rng = ws2.Range("A3:D8")
Dim Header:   Header = ws1.[a2:d2].Value2
M_size = Rng.Columns.Count

ws1.Range("A3:D8").Copy Destination:=Rng

   Dim matrix() As Integer 
   ReDim matrix(M_size - 1, M_size - 1) As Integer:k = 1 'initialize matrix element=0

   For i = 1 To M_size
        matrix(i - 1, i - 1) = Header(1, k): k = k + 1   'change diagonal values
   Next i
   Rng = Application.WorksheetFunction.MMult(Rng, matrix)'multiply 2 matrices
End Sub

.

Надеюсь, это поможет!

Answer 2

Должно быть просто, если вы можете пройти этап формулы:

Private Sub CommandButton1_Click()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim myVal As Range

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set rng = ws2.Range("A3:D8")

Sheets("Sheet1").Range("A3:D8").Copy Destination:=rng
rng.FormulaR1C1="='Sheet1'!R[0]C[0] * 'Sheet1'!R2C[0]"

For Each myVal In rng
    myVal.Formula = myVal.Value
Next myVal

End Sub

Более того, если вам не нужно каждый раз копировать форматирование, оператор .Copy можно удалить.