Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
написание макроса суммы ячеек двух таблиц в третью, написание макроса суммы ячеек двух таблиц в третью
 
#1
02.11.2024 14:14:34
Добрый день! Помогите, пожалуйста.  Есть таблица с числами, в столбце А см в порядке возрастания от 0 примерно до 100, каждому см соответствует свое значение кг в столбце В и есть вторая таблица с мм, где каждому мм соответствует свое значение грамм. Нужно макросом составить третью таблицу, где к каждому см прибавлялось от 0 до 0,99 мм, во втором столбце данные кг+ грамм. Кусок примера прикрепляю. Формулой вводить долго. Заранее спасибо
 
 
 
#2
02.11.2024 14:48:46
можно и формулой не очень долго вводимой
Код
=ОКРУГЛВВЕРХ((СТРОКА(1:1010)-1)/10;1)
=ИНДЕКС(B2:B102;ПОИСКПОЗ(ЦЕЛОЕ(ОКРУГЛВВЕРХ((СТРОКА(1:1010)-1)/10;1));A2:A102;0))
+ИНДЕКС(F2:F11;ПОИСКПОЗ(ОКРУГЛВВЕРХ(ОКРУГЛВВЕРХ((СТРОКА(1:1010)-1)/10;1)
-ЦЕЛОЕ(ОКРУГЛВВЕРХ((СТРОКА(1:1010)-1)/10;1));1);E2:E11;0))
 
 
 
#3
02.11.2024 16:07:28
Код
Option Explicit

Sub Сумма_двух_таблиц()
    Dim r1 As Range
    Dim r2 As Range
    Dim r3 As Range
    
    Set r1 = Range("A2:B21")
    Set r2 = Range("E2:F11")
    Set r3 = Range("I2")
    
    Dim arr As Variant
    arr = GetArr(r1.Value, r2.Value)
    
    r3.Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

Private Function GetArr(arr As Variant, brr As Variant) As Variant
    Dim crr As Variant
    ReDim crr(1 To UBound(arr, 1) * UBound(brr, 1), 1 To 2) As Double
    
    Dim xa As Long
    Dim ya As Long
    Dim yb As Long
    Dim yc As Long
    For ya = 1 To UBound(arr, 1)
        For yb = 1 To UBound(brr, 1)
            yc = yc + 1
            For xa = 1 To UBound(arr, 2)
                crr(yc, xa) = arr(ya, xa) + brr(yb, xa)
            Next
        Next
    Next
    GetArr = crr
End Function
Вариант макросом.
 
 
 
#4
02.11.2024 22:25:23
Ребята, огромное спасибо за участие! Макрос то, что надо! :)  
 
 
 
#5
03.11.2024 11:14:15
pq
 
 
 
Страницы: 1
Наверх