Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос объема - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Макрос объема
nifra Дата: Пятница, 04.05.2012, 17:42 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 162
Репутация: 0 ±
Замечаний: 40% ±

Уважаемые. Хочется услышать от Вас идеи, как можно организовать следующее

В прикрепленном файле.

имеются синие строки и красные столбцы
В синих строках, начиная со второй ячейки (1ая ячейка каждой синей строки это будет порядковый номер и его никак задейстовать не надо) будет вбиваться ширина
В красных столбцах будут вбиваться высота.
На пересечениях высоты и ширины вбиваются буквенные значения (они разные), площадь которых нужно посчитать.

Подробнее: происходит просчет площади на пересечении каждого столбца и строки. Затем происходит поиск сходных буквенно-циферных названий и суммируется их площади.
на скриншоте, как пример, я выделил один тип одинаковых ячеек желтым цветом.
Перемножаются сначала значения 1ого порядкового номера строки (отметил красным номер), потом 2ого (отметил синим).

Про порядковые номера. Между порядковыми номерами специально сделано расстояние в 10 строк ( т.е. между первой и второй строкой где имеются порядковые номер - расстояние в 9 строк, а далее строки идут через 10 (т.е. 10, 20, 30, 40, и тд...) Так устроена программа расчета. Соответственно, все ширины будут располагаться именно через данный промежуток.


Получается, сначала происходит расчет и суммирование площадей одинаковых типов на отрезке B2:E4, затем в B11:E13. После чего каждый отдельный тип суммируется. А сумма каждого типа ( С, 2С, 2СЖ, П) выводится на Листе 2:
С=,
2С=,
2СЖ=,
П=.
К сообщению приложен файл: 2326467.xls (27.5 Kb)


Сообщение отредактировал nifra - Пятница, 04.05.2012, 17:43
 
Ответить
СообщениеУважаемые. Хочется услышать от Вас идеи, как можно организовать следующее

В прикрепленном файле.

имеются синие строки и красные столбцы
В синих строках, начиная со второй ячейки (1ая ячейка каждой синей строки это будет порядковый номер и его никак задейстовать не надо) будет вбиваться ширина
В красных столбцах будут вбиваться высота.
На пересечениях высоты и ширины вбиваются буквенные значения (они разные), площадь которых нужно посчитать.

Подробнее: происходит просчет площади на пересечении каждого столбца и строки. Затем происходит поиск сходных буквенно-циферных названий и суммируется их площади.
на скриншоте, как пример, я выделил один тип одинаковых ячеек желтым цветом.
Перемножаются сначала значения 1ого порядкового номера строки (отметил красным номер), потом 2ого (отметил синим).

Про порядковые номера. Между порядковыми номерами специально сделано расстояние в 10 строк ( т.е. между первой и второй строкой где имеются порядковые номер - расстояние в 9 строк, а далее строки идут через 10 (т.е. 10, 20, 30, 40, и тд...) Так устроена программа расчета. Соответственно, все ширины будут располагаться именно через данный промежуток.


Получается, сначала происходит расчет и суммирование площадей одинаковых типов на отрезке B2:E4, затем в B11:E13. После чего каждый отдельный тип суммируется. А сумма каждого типа ( С, 2С, 2СЖ, П) выводится на Листе 2:
С=,
2С=,
2СЖ=,
П=.

Автор - nifra
Дата добавления - 04.05.2012 в 17:42
nilem Дата: Пятница, 04.05.2012, 20:11 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
Quote (nifra)
...как можно организовать следующее

Например, с помощью зеленой стрелочки
[vba]
Code
Sub ertert()
Dim x, i&, j&, k&, s$, pl#
x = Range("A1:P69").Value
With Sheets("Лист2")
     .Range("A2:B" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).ClearContents
End With
With CreateObject("Scripting.Dictionary")
     .CompareMode = 1
     For i = 1 To UBound(x, 1)
         For j = 1 To UBound(x, 2)
             If Not IsNumeric(x(i, j)) Then
                 s = Trim(x(i, j)): k = (i \ 10) * 10 - (i < 10)
                 pl = x(i, 1) * x(k, j)
                 If .Exists(s) Then .Item(s) = .Item(s) + pl Else .Item(s) = pl
             End If
         Next j
     Next i
     Sheets("Лист2").Range("A2").Resize(.Count).Value = WorksheetFunction.Transpose(.keys)
     Sheets("Лист2").Range("B2").Resize(.Count).Value = WorksheetFunction.Transpose(.items)
End With
Sheets("Лист2").Activate
End Sub
[/vba]
К сообщению приложен файл: _2326467.xlsm (22.5 Kb)


Яндекс.Деньги 4100159601573
 
Ответить
Сообщение
Quote (nifra)
...как можно организовать следующее

Например, с помощью зеленой стрелочки
[vba]
Code
Sub ertert()
Dim x, i&, j&, k&, s$, pl#
x = Range("A1:P69").Value
With Sheets("Лист2")
     .Range("A2:B" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).ClearContents
End With
With CreateObject("Scripting.Dictionary")
     .CompareMode = 1
     For i = 1 To UBound(x, 1)
         For j = 1 To UBound(x, 2)
             If Not IsNumeric(x(i, j)) Then
                 s = Trim(x(i, j)): k = (i \ 10) * 10 - (i < 10)
                 pl = x(i, 1) * x(k, j)
                 If .Exists(s) Then .Item(s) = .Item(s) + pl Else .Item(s) = pl
             End If
         Next j
     Next i
     Sheets("Лист2").Range("A2").Resize(.Count).Value = WorksheetFunction.Transpose(.keys)
     Sheets("Лист2").Range("B2").Resize(.Count).Value = WorksheetFunction.Transpose(.items)
End With
Sheets("Лист2").Activate
End Sub
[/vba]

Автор - nilem
Дата добавления - 04.05.2012 в 20:11
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!