Массив с вариантами уравнений(формул) - Microsoft Office Excel - Страница 3

СтаниславАВ · 02.04.2019, 17:12

Код:

Sub Пересчет_наличия_строк()
    Dim List_smeta, List_materials, List_works, List_materialsVC, List_worksVC As Worksheet
    Dim VB_Smeta_full(), VB_Smeta_m_full(), VB_Smeta_w_full() As Variant
    Dim SmetaFinalRow, SmetaFinalColumn As String
    Dim i, n As Long
    
    Set List_smeta = Application.ThisWorkbook.Sheets("Смета")
    Set List_materials = Application.ThisWorkbook.Sheets("Материалы")
    Set List_works = Application.ThisWorkbook.Sheets("Работы")
    Set List_materialsVC = Application.ThisWorkbook.Sheets("Материалы ВиК")
    Set List_worksVC = Application.ThisWorkbook.Sheets("Работы ВиК")
    
    VB_Smeta_m_full() = Range("Smeta_m_full").Value
    VB_Smeta_w_full() = Range("Smeta_w_full").Value
      
    With List_smeta
         VB_Smeta_full = .Range("B14:BX" & .Cells(.Rows.Count, "BX").End(xlUp).Row).Value
         VB_Smeta_contractor = .Range("Smeta_contractor").Value
         VB_Smeta_contractor_fix = .Range("Smeta_contractor_fix").Value
    End With
     
    ReDim VB_Smeta_full_new(1 To UBound(VB_Smeta_full), 0): n = 1
    For i = 1 To UBound(VB_Smeta_full)
    If Not IsEmpty(VB_Smeta_full(i, 14)) Then
        If VB_Smeta_full(i, 20) = "да" Then
            If VB_Smeta_full(i, 74) = VB_Smeta_contractor_fix Then
                If VB_Smeta_full(i, 74) = VB_Smeta_contractor Then
                   VB_Smeta_full_new(n, 0) = Round(VB_Smeta_full(i, 14) * VB_Smeta_full(i, 15), 0) 
                   n = n + 1
                End If
            End If
        End If
    End If
Next
 
           Range("Smeta_mat_volume") = VB_Smeta_full
 
End Sub

Спасибо Александру за помощь.

5. Проверяем массив VB_Smeta_full, столбец 2 и сравниваем с массивом VB_Smeta_m_full столбец 2, если массивы совпадают
6. Проверяем VB_Smeta_contractor с массивом VB_Smeta_m_full строка 1
7. При совпадении значение пересечения заносится в массив VB_Smeta_full столбец 5
6. Перемножаем в массиве VB_Smeta_full столбец 4 5 и проставляем значение в столбец 6 округлённое значение до копеек.
7. Затем данные из массива ячеек 4,5,6 вставляем в столбцы E,F,G листа Смета

СтаниславАВ · 02.04.2019, 21:24

Поскольку п.5 для меня сложен попробую сначала отсортировать массив VB_Smeta_m_full() строка 1 по значению в ячейке Smeta_contractor_finish.
Далее данные отсортированного столбца перенести в столбец 5 массива VB_Smeta_m_full(). Видимо для этого придётся переопределить массив. А далее уже из столбца 5 массива VB_Smeta_m_full(), переносить значения в столбец 5 массива VB_Smeta_full, значения сравниваться будут из 2 столбцов обеих таблиц.

Код:

    With List_materials
    VB_Smeta_contractor_finish = .Range("Smeta_contractor_finish").Value
    End With
    If VB_Smeta_m_full(1, j) = VB_Smeta_contractor_finish Then
    End If

СтаниславАВ · 02.04.2019, 21:35

Не буду мудрить, сделаю по аналогии уже с выше работающим макросом

Код:

    With List_materials
    VB_Smeta_m_full = .Range("A2:AB" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    VB_Smeta_contractor_finish = .Range("Smeta_contractor_finish").Value
    End With
    
    ReDim VB_Smeta_m_full_new(1 To UBound(VB_Smeta_m_full), 0): m = 1
    For j = 1 To UBound(VB_Smeta_m_full)
        If VB_Smeta_m_full(1, j) = VB_Smeta_contractor_finish Then
        End If
    Next

СтаниславАВ · 03.04.2019, 09:29

Попробую такой код:

Код:

Sub Пересчет_наличия_строк()
    Dim List_smeta, List_materials, List_works, List_materialsVC, List_worksVC As Worksheet
    Dim VB_Smeta_full(), VB_Smeta_full_new(), VB_Smeta_m_full(), VB_Smeta_w_full() As Variant
    Dim SmetaFinalRow, SmetaFinalColumn As String
    Dim i, n, j As Long
     
    Set List_smeta = Application.ThisWorkbook.Sheets("Смета")
    Set List_materials = Application.ThisWorkbook.Sheets("Материалы")
    Set List_works = Application.ThisWorkbook.Sheets("Работы")
    Set List_materialsVC = Application.ThisWorkbook.Sheets("Материалы ВиК")
    Set List_worksVC = Application.ThisWorkbook.Sheets("Работы ВиК")
 
    VB_Smeta_w_full() = Range("Smeta_w_full").Value
 
    With List_smeta
         VB_Smeta_full = .Range("B14:BX" & .Cells(.Rows.Count, "BX").End(xlUp).Row).Value
         VB_Smeta_contractor = .Range("Smeta_contractor").Value
         VB_Smeta_contractor_fix = .Range("Smeta_contractor_fix").Value
         VB_Smeta_contractor_finish = .Range("Smeta_contractor_finish").Value
    End With
     
    ReDim VB_Smeta_full_new(1 To UBound(VB_Smeta_full), 0): n = 1
    For i = 1 To UBound(VB_Smeta_full)
     If Not IsEmpty(VB_Smeta_full(i, 14)) Then
        If VB_Smeta_full(i, 20) = "да" Then
            If VB_Smeta_contractor = VB_Smeta_contractor_fix Then
                If VB_Smeta_full(i, 74) = VB_Smeta_contractor Then
                   VB_Smeta_full_new(n, 0) = Round(VB_Smeta_full(i, 14) * VB_Smeta_full(i, 15), 0)
                   n = n + 1
                End If
            End If
        End If
     End If
    Next
    With List_materials
      VB_Smeta_m_full = .Range("A2:AB" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
      
    For j = 1 To UBound(VB_Smeta_m_full)
        If VB_Smeta_m_full(1, j) = VB_Smeta_contractor_finish Then
           VB_Smeta_m_full(i, 5) = VB_Smeta_m_full(i, j)
        End If
        If VB_Smeta_full(i, 2) = VB_Smeta_m_full(i, 2) Then
           VB_Smeta_full(i, 5) = VB_Smeta_m_full(i, 5)
        End If
    Next

    VB_Smeta_full(i, 6) = Round(VB_Smeta_full(i, 4) * VB_Smeta_full(i, 5), 2)
    Range("Smeta_mat_volume") = VB_Smeta_full(i, 5)
    Range("Smeta_mat_price") = VB_Smeta_full(i, 6)
    Range("Smeta_mat_summa") = VB_Smeta_full(i, 7)
 
End Sub

СтаниславАВ · 03.04.2019, 12:45

Друзья. Проблема, оператор j определяется правильно, 7
А вот со строкой не правильно:

Код:

    For j = 1 To UBound(VB_Smeta_m_full)
        If VB_Smeta_m_full(1, j) = VB_Smeta_contractor_finish Then
           VB_Smeta_m_full(k, 5) = VB_Smeta_m_full(k, j)

Как можно определить правильно строку? Спасибо.

СтаниславАВ · 03.04.2019, 22:30

Так тоже не работает

Код:

Sub Пересчет_наличия_строк()
    Dim List_smeta, List_materials, List_works, List_materialsVC, List_worksVC As Worksheet
    Dim VB_Smeta_full(), VB_Smeta_full_new(), VB_Smeta_m_full(), VB_Smeta_w_full() As Variant
    Dim VB_Smeta_contractor, VB_Smeta_contractor_fix, VB_Smeta_contractor_finish As String
    Dim i, m, n, j As Long
     
    Set List_smeta = Application.ThisWorkbook.Sheets("Смета")
    Set List_materials = Application.ThisWorkbook.Sheets("Материалы")
    Set List_works = Application.ThisWorkbook.Sheets("Работы")
    Set List_materialsVC = Application.ThisWorkbook.Sheets("Материалы ВиК")
    Set List_worksVC = Application.ThisWorkbook.Sheets("Работы ВиК")
     
 VB_Smeta_w_full() = Range("Smeta_w_full").Value
  
    With List_smeta
         VB_Smeta_full = .Range("B14:BX" & .Cells(.Rows.Count, "BX").End(xlUp).Row).Value
         VB_Smeta_contractor = .Range("Smeta_contractor").Value
         VB_Smeta_contractor_fix = .Range("Smeta_contractor_fix").Value
         VB_Smeta_contractor_finish = .Range("Smeta_contractor_finish").Value
    End With
      
    ReDim VB_Smeta_full_new(1 To UBound(VB_Smeta_full), 0): n = 1
    For i = 1 To UBound(VB_Smeta_full)
     If Not IsEmpty(VB_Smeta_full(i, 14)) Then
        If VB_Smeta_full(i, 20) = "да" Then
            If VB_Smeta_contractor = VB_Smeta_contractor_fix Then
                If VB_Smeta_full(i, 74) = VB_Smeta_contractor Then
                   VB_Smeta_full_new(n, 0) = Round(VB_Smeta_full(i, 14) * VB_Smeta_full(i, 15), 0)
                   n = n + 1
                End If
            End If
        End If
     End If
    Next
    With List_materials
      VB_Smeta_m_full = .Range("A2:AB" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
  
    For j = 6 To UBound(VB_Smeta_m_full)
    For k = 2 To UBound(VB_Smeta_m_full, 5)
        If VB_Smeta_m_full(1, j) = VB_Smeta_contractor_finish Then
 
           VB_Smeta_m_full(k, 5) = VB_Smeta_m_full(k, j)
   
        End If
    Next
    Next
  
    VB_Smeta_full(i, 6) = Round(VB_Smeta_full(i, 4) * VB_Smeta_full(i, 5), 2)
    Range("Smeta_mat_volume") = VB_Smeta_full(i, 5)
    Range("Smeta_mat_price") = VB_Smeta_full(i, 6)
    Range("Smeta_mat_summa") = VB_Smeta_full(i, 7)
  
End Sub

VB_Smeta_m_full индексируется правильно, а вот со строками возникает проблема.

СтаниславАВ · 04.04.2019, 09:05

Код:

    For j = 6 To UBound(VB_Smeta_m_full) 'определяем количество столбцов
        If VB_Smeta_m_full(1, j) = VB_Smeta_contractor_finish Then 'находим необходимый столбец по первой строке
            For k = 1 To LBound(VB_Smeta_m_full) 'определяем количество строк
                VB_Smeta_m_full(k, 5) = VB_Smeta_m_full(k, j) 'перебираю построчно со второй строки и подставляю значения из колонки j в колонку 5, а так же
                If VB_Smeta_full(i, 2) = VB_Smeta_m_full(k, 2) Then 'в массиве VB_Smeta_full перебираю столбец 2 и при совпадении со строкой во 2 столбце массива VB_Smeta_m_full
                   VB_Smeta_full(i, 5) = VB_Smeta_m_full(k, j) 'подставляю данные из массива VB_Smeta_m_full, столбца 5, соответствующей строки, данные в массив VB_Smeta_full, столбец 5 соответствующей строки
                End If
            Next
        End If
    Next

Выдаёт ошибку.

СтаниславАВ · 04.04.2019, 15:25

Подскажите пожалуйста. В памяти есть массив a

Код:

Sub Test3()Dim a As Variant, i As Long
  a = Лист1.Range("A1:C5")
    For i = 1 To 5
      a(i, 3) = a(i, 1)  * a(i, 2)
    Next
  Лист2.Range("A1:C5") = a
End Sub
Его нужно вставлять частями:
Лист2.Range("B1:B5") = a?
и
Лист2.Range("С1:C5") = a?

Как можно прописать макрос a в двух верхних формулах? Спасибо.

Код:

Sub Test3()Dim a As Variant, i As Long
  a = Лист1.Range("A1:C5")
    For i = 1 To 5
      a(i, 3) = a(i, 1)  * a(i, 2)
    Next
  Лист2.Range("B1:B5") = a(i, 2) '?
  Лист2.Range("C1:C5") = a(i, 3) '?
 
End Sub

СтаниславАВ · 05.04.2019, 09:58

Помогите пожалуйста объяснить отличие

Код:

    ReDim VB_Smeta_full_new(1 To UBound(VB_Smeta_full), 0): n = 1
    For i = 1 To UBound(VB_Smeta_full)
     If Not IsEmpty(VB_Smeta_full(i, 14)) Then
        If VB_Smeta_full(i, 20) = "да" Then
            If VB_Smeta_contractor = VB_Smeta_contractor_fix Then
                If VB_Smeta_full(i, 74) = VB_Smeta_contractor Then
                   VB_Smeta_full_new(n, 0) = Round(VB_Smeta_full(i, 14) * VB_Smeta_full(i, 15), 0)
                   n = n + 1

от

Код:

    For i = 1 To UBound(VB_Smeta_full)
     If Not IsEmpty(VB_Smeta_full(i, 14)) Then
        If VB_Smeta_full(i, 20) = "да" Then
            If VB_Smeta_contractor = VB_Smeta_contractor_fix Then
                If VB_Smeta_full(i, 74) = VB_Smeta_contractor Then
                   VB_Smeta_full(i, 4) = Round(VB_Smeta_full(i, 14) * VB_Smeta_full(i, 15), 0)

этого
P.S. нижний почему то столбец 4 в массиве не перезаписывает. А в первом коде я перезаписанные данные не могу найти (((

Поясню зачем мне это необходимо:

Код:

'Создаю новый одномерный массив
VB_Smeta_volume(i)=VB_Smeta_full(i, 4) 'и переношу внего данные из массива VB_Smeta_full(i, 4) столбец 4
Range("Smeta_volume").Value = Application.Transpose(VB_Smeta_volume) 'далее данные одномерного макроса VB_Smeta_volume копирую в столбец диапазона Smeta_volume

СтаниславАВ · 05.04.2019, 15:11

Спасибо Sanja. По первому этапу добился того, что надо

Код:

    For SV = 1 To UBound(VB_Smeta_full)
      If VB_Smeta_full(SV, 14) = 0 Then
        If VB_Smeta_full(SV, 20) = "да" Then
            If VB_Smeta_contractor = VB_Smeta_contractor_fix Then
                   VB_Smeta_full(SV, 4) = Round(VB_Smeta_full(SV, 14) * VB_Smeta_full(SV, 15), 0)
                   VB_Smeta_volume(SV, 1) = VB_Smeta_full(SV, 4)
                Else
                If VB_Smeta_full(SV, 74) = VB_Smeta_contractor Then
                   VB_Smeta_full(SV, 4) = Round(VB_Smeta_full(SV, 14) * VB_Smeta_full(SV, 15), 0)
                   VB_Smeta_volume(SV, 1) = VB_Smeta_full(SV, 4)
                End If
            End If
        End If
     End If
    Next
    With List_smeta
        .Range("E13").Resize(UBound(VB_Smeta_volume), 1) = VB_Smeta_volume
    End With

Есть вопрос про второй этап.

Код:

    With List_materials
      VB_Smeta_m_full = .Range("A2:AB" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
    End With
    For Mat = 1 To UBound(VB_Smeta_m_full)
         For SV = 1 To UBound(VB_Smeta_full)
           If VB_Smeta_m_full(Mat, 2) = VB_Smeta_full(SV, 2) Then
              VB_Smeta_m_full(Mat, 4) = VB_Smeta_full(SV, 4)
           End If
         Next
    Next

Вопрос который решается с помощью обычной формулы СуммЕсли
Берём значение из ячейки VB_Smeta_m_full(Mat, 2) находим соответствующий текст в ячейке VB_Smeta_full(SV, 2) и если текст совпадает суммируем
VB_Smeta_m_full(Mat, 4) = VB_Smeta_full(SV, 4) + ........
Идем дальше, находим аналогичный текст и опять прибавляем к предыдущему.
VB_Smeta_m_full(Mat, 4) = VB_Smeta_full(SV+1, 4)+VB_Smeta_full(SV, 4) + ........
Подскажите пожалуйста, как можно реализовать?
Спасибо.

02.04.2019, 21:24	#22
СтаниславАВ Форумчанин Регистрация: 10.10.2010 Сообщений: 107	Поскольку п.5 для меня сложен попробую сначала отсортировать массив VB_Smeta_m_full() строка 1 по значению в ячейке Smeta_contractor_finish. Далее данные отсортированного столбца перенести в столбец 5 массива VB_Smeta_m_full(). Видимо для этого придётся переопределить массив. А далее уже из столбца 5 массива VB_Smeta_m_full(), переносить значения в столбец 5 массива VB_Smeta_full, значения сравниваться будут из 2 столбцов обеих таблиц. Код: `With List_materials VB_Smeta_contractor_finish = .Range("Smeta_contractor_finish").Value End With If VB_Smeta_m_full(1, j) = VB_Smeta_contractor_finish Then End If`

02.04.2019, 21:35	#23
СтаниславАВ Форумчанин Регистрация: 10.10.2010 Сообщений: 107	Не буду мудрить, сделаю по аналогии уже с выше работающим макросом Код: `With List_materials VB_Smeta_m_full = .Range("A2:AB" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value VB_Smeta_contractor_finish = .Range("Smeta_contractor_finish").Value End With ReDim VB_Smeta_m_full_new(1 To UBound(VB_Smeta_m_full), 0): m = 1 For j = 1 To UBound(VB_Smeta_m_full) If VB_Smeta_m_full(1, j) = VB_Smeta_contractor_finish Then End If Next` Последний раз редактировалось СтаниславАВ; 02.04.2019 в 21:49.

03.04.2019, 12:45	#25
СтаниславАВ Форумчанин Регистрация: 10.10.2010 Сообщений: 107	Друзья. Проблема, оператор j определяется правильно, 7 А вот со строкой не правильно: Код: `For j = 1 To UBound(VB_Smeta_m_full) If VB_Smeta_m_full(1, j) = VB_Smeta_contractor_finish Then VB_Smeta_m_full(k, 5) = VB_Smeta_m_full(k, j)` Как можно определить правильно строку? Спасибо. Последний раз редактировалось СтаниславАВ; 03.04.2019 в 13:12.

05.04.2019, 15:11	#30
СтаниславАВ Форумчанин Регистрация: 10.10.2010 Сообщений: 107	Спасибо Sanja. По первому этапу добился того, что надо Код: For SV = 1 To UBound(VB_Smeta_full) If VB_Smeta_full(SV, 14) = 0 Then If VB_Smeta_full(SV, 20) = "да" Then If VB_Smeta_contractor = VB_Smeta_contractor_fix Then VB_Smeta_full(SV, 4) = Round(VB_Smeta_full(SV, 14) * VB_Smeta_full(SV, 15), 0) VB_Smeta_volume(SV, 1) = VB_Smeta_full(SV, 4) Else If VB_Smeta_full(SV, 74) = VB_Smeta_contractor Then VB_Smeta_full(SV, 4) = Round(VB_Smeta_full(SV, 14) * VB_Smeta_full(SV, 15), 0) VB_Smeta_volume(SV, 1) = VB_Smeta_full(SV, 4) End If End If End If End If Next With List_smeta .Range("E13").Resize(UBound(VB_Smeta_volume), 1) = VB_Smeta_volume End With Есть вопрос про второй этап. Код: `With List_materials VB_Smeta_m_full = .Range("A2:AB" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value End With For Mat = 1 To UBound(VB_Smeta_m_full) For SV = 1 To UBound(VB_Smeta_full) If VB_Smeta_m_full(Mat, 2) = VB_Smeta_full(SV, 2) Then VB_Smeta_m_full(Mat, 4) = VB_Smeta_full(SV, 4) End If Next Next` Вопрос который решается с помощью обычной формулы СуммЕсли Берём значение из ячейки VB_Smeta_m_full(Mat, 2) находим соответствующий текст в ячейке VB_Smeta_full(SV, 2) и если текст совпадает суммируем VB_Smeta_m_full(Mat, 4) = VB_Smeta_full(SV, 4) + ........ Идем дальше, находим аналогичный текст и опять прибавляем к предыдущему. VB_Smeta_m_full(Mat, 4) = VB_Smeta_full(SV+1, 4)+VB_Smeta_full(SV, 4) + ........ Подскажите пожалуйста, как можно реализовать? Спасибо.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Запись с вариантами	andrei_belko	Паскаль, Turbo Pascal, PascalABC.NET	2	03.06.2014 17:12
Записи вариантами.	alexeu121	Паскаль, Turbo Pascal, PascalABC.NET	7	28.05.2014 10:26
Записи с вариантами	megabobik	Помощь студентам	0	31.01.2010 16:17
Запись с вариантами	Rusl92	Помощь студентам	1	14.11.2009 10:27
MainMenu с вариантами	beegl	Компоненты Delphi	4	08.06.2008 12:09