Оптимизация технологии производства деталей заготовительно-штамповочной оснастки тема диссертации и автореферата по ВАК РФ 05.02.08, кандидат наук Исаченко Алексей Сергеевич

• Исаченко Алексей Сергеевич
• кандидат наук
• 2019

Оглавление диссертации кандидат наук Исаченко Алексей Сергеевич

Введение

1 Проблема переналадки участков по производству оснастки заготовительно-штамповочного производства

1.1 Организационная и технологическая характеристика участка по производству оснастки заготовительно-штамповочного производства

1.2 Оперативно-календарное планирование для цеха производства оснастки заготовительно-штамповочного производства

1.3 Снижение времени перехода на новое изделие путем внедрения методики быстрой переналадки

1.4 Постановка цели и задач исследования

1.5 Выводы по разделу

2 Группирование единиц планирования при помощи кластерного анализа

2.1 Классификатор изготавливаемой продукции

2.2 Кластерный анализ как инструмент снижения времени перехода на новое изделие

2.3 Приоритетная двухходовая кластеризация

2.4 Выводы по разделу

3 Унификация вылетов концевого инструмента

3.1 Вылет концевого инструмента как критерий унификации наладки

3.2 Подтверждение достоверности машинного эксперимента

3.3 Номограмма отжима фрезы

3.4 Выводы по разделу

4 Снижение времени переналадки путем применения методики SMED

4.1 Процедура внедрения быстрой переналадки

4.2 Апробация внедрения быстрой переналадки на станке DymmШ

4.3 Автоматизация процедуры внедрения быстрой переналадки

4.4 Выводы по разделу

Заключение

Список литературы

Приложения

Введение

Введение диссертации (часть автореферата) на тему «Оптимизация технологии производства деталей заготовительно-штамповочной оснастки»

Актуальность темы

Современные тенденции развития машиностроительного производства связаны с такими критериями оценки деятельности предприятий, как количество и качество изготавливаемой продукции разнообразной номенклатуры с минимальными временными и материальными затратами.

Традиционно, предприятия крупносерийного и массового производства привлекают больше внимания исследователей за счет более обширных возможностей автоматизации технологических процессов, ритмичности выпуска продукции и жесткой структуризации последовательности расположения рабочих мест и хода выполнения обработки деталей [1]. Однако нынешние рыночные условия часто требуют перехода к мелкосерийному или единичному производству, что в свою очередь подразумевает потребность в способности предприятия в кратчайшие сроки адаптироваться к новым требованиям рынка [2, 3]. Гибкость управленческой структуры и возможность оперативно перестраивать производственные процессы являются преимуществами малых и средних предприятий машиностроения [4, 5].

За рубежом четко прослеживается тенденция к увеличению доли предприятий малого бизнеса не только в производстве узкоспециализированной машиностроительной продукции, но и изделий общего назначения. Такие предприятия динамично реагируют на изменения требований потребителя к номенклатуре и качеству, создают инновационные производственные процессы, что влияет на их конкурентоспособность. В таких странах, как США, Великобритания, Германия и Канада, доля малого бизнеса в производстве составляет 40-70%, в то время как в России данный показатель примерно в пять раз ниже [4].

Машиностроительный малый бизнес должен кооперироваться и интегрироваться с крупными предприятиями, но в настоящее время существует мало отечественных производств, способных производить запрашиваемые

крупными предприятиями непрофильные изделия, удовлетворяющие их календарным и качественным требованиям. Выполнение данных условий требует оптимизации технологии производства, состоящей из способов, приемов и последовательности изготовления продукции или выполнения работ, обеспечивающих рациональное использование всех ресурсов.

Цеха изготовления оснастки в заготовительно-штамповочном производстве характеризуются схожестью управленческой структуры с вышерассматриваемымыми, а также единичным выпуском деталей различных конструкций и частой сменой объекта производства на неспециализированных рабочих местах. В таких условиях время механообработки на станке составляет малую долю всего рабочего времени, большая часть которого тратится на подготовительно-заключительные операции, такие как переналадка станка. Кроме того, особенностью производства в таких цехах является необходимость выполнения заказов в виде комплекта деталей или сборочных единиц к фиксированному сроку. Изделия могут выпускаться парно - в прямом и отраженном исполнениях, как в авто- и авиастроении.

Прослеживается проблема, состоящая в том, что широкая номенклатура и единичный выпуск изделий не позволяют накапливать данные о технологических процессах и затрудняют оптимизацию технологии производства, ввиду отсутствия соответствующей системы планирования. Традиционные системы планирования, подходящие для крупносерийного производства, устарели и нуждаются в изменении и модернизации под требования предприятий малого бизнеса. Одним из вариантов решения задачи цехового планирования является применение MES-систем (Manufacturing Execution System, системы оперативного управления производством), учитывающих данные особенности.

В связи с этим, важной и актуальной проблемой является разработка методов снижения времени перехода на новое изделие в цехах изготовления оснастки для повышения эффективности их работы в заготовительно -штамповочном производстве с учетом широкой номенклатуры изделий,

единичного выпуска и частой сменой производственной ситуации, и их интеграция с MES-системой, применяемой на производстве.

Степень разработанности проблемы

Проблемам повышения эффективности работы оборудования в условиях современного производства посвящены труды авторов Бочкарева П. Ю., Митина С. Г., Горлова Е. В., Загиддулина Р. Р., Чигиринского Ю. Л., Синго С., Owsinski J. W., Van Goubergen D., и др. Однако в трудах этих ученых не рассматриваются такие особенности цехов производства оснастки заготовительно-штамповочного производства, как неравнозначность технико-технологических признаков единиц планирования при составлении последовательности запуска в производство и значительные различия в конструкции изделий, предотвращающие применение групповой технологии.

За последние годы была защищена одна диссертация на соискание степени кандидата технических наук Ивановым А. А. по теме «Разработка моделей и алгоритмов проектных процедур управления производством в системе планирования многономенклатурных технологических процессов механообработки», защищенная в 2016 г. в г. Саратов, и одна диссертация на соискание степени доктора технических наук Митиным С. Г. по теме «Синтез технологических операций со сложной структурой в многономенклатурных системах механообработки», защищенная в 2017 г. в г. Пенза.

Объект и предмет исследования

Объектом исследования является технология производства деталей заготовительно-штамповочной оснастки. Предметами исследования являются методы сокращения и оптимизации подготовительно-заключительного и организационного времен в механизме запуска в производство.

Цель работы

Целью работы является повышение эффективности работы в цехах изготовления оснастки для заготовительно-штамповочного производства на основе создания оптимального процесса переналадки оборудования при смене номенклатуры обрабатываемых деталей оснастки.

Задачи работы

1. Установить закономерности между маршрутом технологического процесса и наладкой оборудования.

2. Разработать алгоритм составления желаемой последовательности запуска в производство, учитывающей только снижение времени, затрачиваемого на монтаж/демонтаж инструмента и установку заготовки, и модифицировать его модулем приоритетов для условий неравнозначности технико-технологических признаков единиц планирования.

3. Создать интуитивно понятный и легко применимый алгоритм унификации инструментальной наладки концевого фрезерного инструмента для обработки оснастки заготовительно-штамповочного производства на станках с ЧПУ.

4. Установить логические связи вспомогательных переходов и приемов в процедуре переналадки станков с ЧПУ и автоматизировать процесс разделения микроэлементов процедуры переналадки на внешние и внутренние в аналитической карте переналадки станков с ЧПУ.

Научная новизна

Научная новизна характеризуется следующими положениями:

1. Получены новые логические связи между технико-технологическими и конструкторскими признаками деталей, последовательно запускаемых в производство, и инструментальной наладкой, осуществляющей комплекс работ над объектом производства, что позволяет снизить время простоя оборудования за счет группирования единиц планирования по общности наладки (п. 5 паспорта специальности 05.02.08).

2. Модифицировано уравнение для определения отжима концевой фрезы в направлении тангенциальной силы резания с учетом неоднородности сечения, особенности геометрии инструмента, и жесткости станка, что позволяет унифицировать инструментальную наладку по вылету концевого инструмента путем определения отжима и погрешности обрабатываемого контура (п. 7 паспорта специальности 05.02.08).

3. Усовершенствован метод составления оптимальной последовательности запуска единиц планирования в производство в условиях неравнозначности технико-технологических признаков за счет введения модуля приоритетов, что позволяет учитывать особенности производства при составлении последовательности запуска деталей в производство для снижения времени простоя оборудования (п. 5 паспорта специальности 05.02.08).

4. Предложен алгоритм исполнения процедуры быстрой переналадки, содержащий новый блок на основе математической логики и теории нечетких множеств, работающий на списках приемов и вспомогательных технологических переходов, который позволяет дополнительно минимизировать время внедрения методики быстрой переналадки (п. 2 паспорта специальности 05.02.08).

Практическая значимость и реализация результатов работы.

Получен автоматизированный способ формирования последовательности запуска в производство в многономенклатурном производстве, обеспечивающий учет сходства переналадки. Предложен способ унификации концевого инструмента на основе отжима в наихудших условиях работы. Для быстрого получения значения отжима без расчетов разработана номограмма. Предложен метод автоматизированного вынесения предложений по внедрению быстрой переналадки на станках с ЧПУ на основе ключевых слов.

Методы и средства исследования

Теоретические исследования выполнены с использованием научных основ технологии машиностроения, теории упругости и сопротивления материалов, математических аппаратов теории множеств, теории комбинаторной оптимизации и теории нечетких множеств. Экспериментальные исследования проводились в условиях лаборатории ИРНИТУ и цехе производства оснастки на Иркутском авиационном заводе с применением статистических методов обработки данных. Машинный эксперимент проводился в среде Siemens Unigraphics NX 8.5 на основе конечно-элементных моделей. При разработке программного модуля был применен аппарат Visual Basic, встроенный в среду Microsoft Excel.

Достоверность результатов работы

Достоверность научных результатов подтверждается проверкой адекватности выявленных закономерностей и составленных моделей при помощи машинных и натурных экспериментальных исследований, а также использованием сертифицированного программного обеспечения для выполнения расчётов. Полученные результаты не противоречат данным других исследований.

Апробация работы

Апробация результатов диссертации проводилась на международных и всероссийских научно-технических и научно-практических конференциях: «Будущее машиностроения России» (Москва, 2015), «Молодежь. Проекты. Идеи» (Иркутск, 2015), «Авиамашиностроение и транспорт Сибири» (Иркутск, 2016), «Новая наука: проблемы и перспективы» (Стерлитамак, 2016), «Молодежь. Проекты. Идеи» (Иркутск, 2017), «Автоматизированное проектирование в машиностроении» (Новокузнецк, 2017).

Публикации

По материалам научно-квалификационной работы опубликовано 7 печатных работ, в том числе 4 статьи в журналах, рекомендованных ВАК РФ.

Диссертация подготовлена на кафедре технологии и оборудования машиностроительных производств Федерального государственного бюджетного образовательного учреждения высшего образования «Иркутский национальный исследовательский технический университет».

Диссертация состоит из четырех глав.

В первой главе приведены конструктивные и технологические особенности изделий, изготавливаемых в цехах производства оснастки заготовительно-штамповочного производства. Рассмотрены особенности данного вида производства. Проанализированы существующие методики оптимизации использования рабочего времени в рассматриваемом производстве.

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

различий в наладке. Составлен алгоритм составление оптимальной последовательности запуска деталей в производство, работающий на основе аппарата кластерного анализа. Для условий неравнозначности технико-технологических признаков, влияющих на процесс переналадки, составлен модифицированный алгоритм, который учитывает особенности реальных производственных условий.

Третъя глава посвящена разработке методики унификации наладки концевого инструмента по вылету. Рассмотрены потери времени при переходе на новое изделие, связанные с коррекцией длины вылета концевого инструмента. Предложена методика унификации инструментальной наладки по вылету без потери точности обрабатываемого контура. Проведен машинный эксперимент для определения влияния количества зубьев фрезы на момент инерции. Описан натурный эксперимент для определения поправочного коэффициента для учета жесткости шпиндельного узла станка. Составлены номограммы для определения отжима быстрорежущих концевых фрез при обработке алюминиевых сплавов.

В четвертой главе рассматриваются модифицированная процедура внедрения SMED и методы ее интеграции с используемой на производстве MES-системой. Описывается апробация полученной процедуры на станке Mecof DynamШ 3000. Приводится алгоритм автоматического составления аналитической карты процесса переналадки, работающий на основе аппарата математической логики и теории нечетких множеств.

По результатам проделанных работ автор выносит на защиту:

1. Алгоритм составления последовательности запуска деталей в производство посредством кластерного анализа на основе общности технико-технологических признаков деталей как в условиях равнозначности этих признаков, так и в условиях их неравнозначности.

2. Результат применения макроса вышеупомянутого алгоритма для составления последовательности запуска в производство деталей цеха изготовления оснастки заготовительно-штамповочного производства.

3. Номограммы определения отжима двух-, трех- и четырехзубых концевых фрез при обработке алюминиевых сплавов. Количественные данные по машинному и натурному экспериментам.

4. Алгоритм автоматического разделения микроэлементов процедуры переналадки на внешние и внутренние, работающий на основе списка вспомогательных приемов.

Структура и объем работы. Диссертация имеет введение, четыре главы, заключение, список литературы насчитывающий 110 источников, и приложения. Работа содержит 15 таблиц и 23 рисунка. Общий объем работы 146 страниц.

Автор выражает благодарность своему научному руководителю д.т.н., проф. Д. А. Журавлеву за внимательное и критическое отношение к данной работе. Автор также благодарен к.т.н., доц. Казимирову Д. Ю. за ценные советы и помощь в подготовке диссертации. Автор выражает признательность коллективу отдела заготовительно-штамповочного производства Иркутского авиационного завода за помощь в проведении исследований.

1 Проблема переналадки участков по производству оснастки заготовительно-штамповочного производства

1.1 Организационная и технологическая характеристика участка по производству оснастки заготовительно-штамповочного

производства

Традиционно, машиностроительное производство имеет серийный характер, но современные тенденции его развития часто требуют перехода к мелкосерийному или единичному производству. Цеха изготовления оснастки в заготовительно-штамповочном производстве характеризуются изготовлением деталей различных конструкций с однократным выпуском и частой сменой объекта производства на неспециализированных рабочих местах. Более того, их особенностью является необходимость выполнения заказов в виде целого комплекта деталей и сборочных единиц к фиксированному сроку. В таких цехах изделия часто выпускаются парно - в прямом и отраженном исполнениях.

В таком производстве, где постоянно запускаются в исполнение новые заказы с оригинальной технологией их изготовления, а сроки выпуска продукции диктуются потребителем и могут изменяться непосредственно в процессе обработки, применяются «вытягивающие» логистические системы [6].

В цехах изготовления оснастки заготовительно-штамповочного производства подвергаются механообработке такие изделия, как оправки, накладки, бобышки, болванки, штампы, матрицы, пуансоны, оправки профильно-гибочного растяжения (ПГР), контрольные плазы, лекала, литейные модели, тара, ложементы, подставки под сверловку или фрезеровку и др. Данные изделия имеют широкий диапазон габаритных размеров - длину и ширину от 40 до 6000 мм, высоту от 10 до 700 мм. Могут присутствовать как прямолинейные, так и криволинейные поверхности сложной формы. На основе анализа работы технологического отдела за один год были рассчитаны доли разных видов изделий в общем объеме производства (таблица 1).

Таблица 1 - Объекты производства

Наименование Вид Доля в общем объеме производства

Литейная модель -2%

Болванка / -21%

Оправка <с> -45%

Контрольный плаз -12%

Подставка -2%

Оправка П1Р -4%

Ложемент -7%

Матрица -8%

и др.

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

Такие конструктивные элементы, как наклонные поверхности, в общих случаях обязывают к применению 5-координатной обработки. Литейные уклоны на литейных моделях могут быть обработаны при помощи специальной конической фрезы, что позволяет обрабатывать некоторые литейные модели на 3-координатных станках.

На некоторых деталях, таких как матрицы, могут присутствовать углубления, вынуждающие использовать удлинители инструмента. Крупногабаритные заготовки, обрабатываемые на столе станка без подставок, требуют создания специальных вырезов для установки прихватов. Многие детали не могут быть обработаны за один установ. Некоторые крупногабаритные детали и детали, контур которых обрабатывается с трех или более сторон, должны обрабатываться с промежуточной остановкой оборудования для переустановки прихватов, чтобы предотвратить отгиб заготовки.

Гребенка на лекалах контрольных плазов требует особой последовательности обработки из-за возможности скола углов при черновой обработке. В случае изготовления тонких длинных болванок, не допускающих смены положения прихватов или закрепления на подставках, используется заготовка увеличенных габаритов с потребностью в ручной доработке после механообработки на станке. Болванки с медными шинами предусматривают обработку как минимум за два установа - без установленных шин и с установленными шинами.

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

Рисунок 1 - Вариант технологического процесса для обработки четырех деталей - назначение операции обрабатывающей группы ТО Оп - Операция

ТО - технологическое оборудование ТП - Технологический процесс

Участки изготовления оснастки заготовительно-штамповочного производства комплектуются оборудованием с ЧПУ с длительным сроком окупаемости и стандартной оснасткой. В работе [7] говорится о том, что в среднем вся станочная система в таких производствах остается наполовину недогруженной, что происходит из-за постоянных перегрузок одного оборудования и одновременного простоя другого в ожидании работы, связанной с изделиями, пролеживающими в очереди на предыдущих стадиях обработки, что приводит к снижению производительности.

Широкая номенклатура изготавливаемых изделий создает затруднения в бесперебойном снабжении, вызывая накопление незавершенного производства. Одновременное нахождение в производстве различных изделий приводит к

усложнению оперативного руководства производственными процессами и его децентрализации. Это влечет за собой увеличение трудоемкости, объема незавершенного производства и себестоимости готовых изделий. Однократный выпуск продукции приводит к тому, что затраты на разработку пооперационного технологического процесса не оправдываются экономически. Поэтому операция наладки обычно не регламентируется технологическим процессом.

Станки с ЧПУ, входящие в состав участков цеха изготовления оснастки, обладают длительным временем переналадки при смене объекта производства, что напрямую влияет на производственную мощность. Из этого следует, что одной из крупных проблем в цехах изготовления оснастки заготовительно-штамповочного производства является частая и длительная переналадка. Сокращение времени переналадки предоставляет множество преимуществ для предприятия [8-12].

Штучно-калькуляционное время изготовления детали, т.е. технически обоснованная норма времени на выполнение операции, рассчитывается по следующей формуле [13]:

Тщ.К. = ?ШТ + Тп.З ./^ а)

где 7Ш.К. - штучно-калькуляционное время; тШТ - штучное время;

тпз - подготовительно-заключительное время; п - объем партии.

В свою очередь, подготовительно-заключительное время определяется по следующей формуле:

Тп.З. = Тпз1 + Тпз2. + ^пр.обр, (2)

где ткз - подготовительно-заключительное время;

тпз1 - норма времени на организационную подготовку;

Тп32 - норма времени на наладку станка, приспособления, инструмента, программных устройств;

^пробр - норма времени на пробную обработку.

Время комплекса приемов по переналадке при поступлении новой единицы планирования можно представить как арифметическую сумму простейших действий оператора ЧПУ:

^пз2 ^успр + ^усио + ^напр + ^обн + ^тр + ^сб + ^пр + ^др, (3)

где гпз2 - время переналадки;

¿успр - время установки приспособления;

£усио - время установки основного инструмента;

£напр - время настройки и привязки;

£обн - время обнуления инструмента;

£тр - время транспортировки заготовки и оснащения;

£сб - время сборки и комплектации;

£пр - время пробных ходов;

£др - время, потраченное на другие действия.

Тогда обобщенная математическая модель задачи оперативно-календарного планирования для цеха, имеющая отношение к рассматриваемому виду производства, имеет следующий вид.

^ =

X ^ ^ тш

к=1

т р1

XX еП ^ т1п

1=1 ]=1

(4)

ечк \wijk }>

т Рг / \

X X ечк а • ¡Ое^ + Тпз2еук ) < Фск ' (5)

г=1 J=1

где т > 1; п > 1; 2 > ау > 0;

вук - единица планирования с номером детали ¡, номером операции у, номером единицы оборудования, на котором она будет выполняться, к; еПу - количество переналадок;

Wijk - операция с номером у для детали с номером ¡, выполняемая на единице оборудования с номером к;

п

Gij = const - величина партии запуска единиц планирования; pi > 1 - количество операция на i-й детали;

Фск - фонд времени работы к-й единицы оборудования на горизонте планирования.

Основными потерями времени для каждой единицы оборудования являются Tm2e - потери времени, связанные с наличием операций переналадок для единицы оборудования при поступлении новых деталей, что не противоречит

[14].

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

Блок (5) включает условие задания единицы планирования в виде операций и отражает требования к функционированию единицы оборудования, являющиеся ограничением по фонду времени работы каждой единицы оборудования в цеху.

1.2 Оперативно-календарное планирование для цеха производства оснастки заготовительно-штамповочного производства

Основоположниками производственного планирования принято считать Ф. Тейлора, определившего ключевые функции планирования и создавшего отдел планирования; Г. Гантта, создавшего диаграммы для совершенствования принятия решений по планированию; и С. Джонсона, положившего начало математическому анализу проблем планирования производства [15].

Основной задачей оперативно-календарного планирования является построение четкой последовательности выполнения технологических и вспомогательных операций на заданном интервале времени в пределах производственного цеха, участка или иного комплекса оборудования [2, 3]. Такая последовательность называется расписанием работы оборудования [14].

Составление расписаний может быть автоматизировано посредством информационных технологий, таких как MES-системы, которые в оперативном

инициируют, отслеживают, оптимизируют, документируют производственные процессы от начала выполнения заказа до выпуска готовой продукции. Однако, в работе [16] говорится о необходимости использования методик производственного планирования, учитывающих реальное состояние производство, и интеграции их с другими системами планирования производства, что, как показывает исследование [17], является сложным процессом.

Традиционные системы планирования, используемые на механообрабатывающем производстве, имеют ряд недостатков [18]:

- длительность сроков проработки плана;

- недостоверные сроки изготовления деталей;

- отсутствие проработанного по срокам производственного плана по участкам;

- некорректное распределение номенклатуры по участкам;

- распределением заданий по рабочим местам занимается мастер;

Список литературы диссертационного исследования кандидат наук Исаченко Алексей Сергеевич, 2019 год

- 23 с.

106. The process of manufacturing-capability development in industrial cluster

- A case study of the automotive cluster of Slovenia / T. Fulder, I. Palcic, A. Polajnar, P. Pizmoht // Strojniski vestnik - Journal of Mechanical Engineering. - 2005. - Vol. 51, № 12. - P. 771-785.

107. Казимиров, Д. Ю. Снижение времени перехода на новое изделие путем внедрения быстрой переналадки станков с ЧПУ / Д. Ю. Казимиров, А. С. Исаченко // Фундаментальные и прикладные проблемы техники и технологии. - 2015. - Т. 1, № 5 (313). - С. 71-80.

108. Anisic, Z. Assembly initiated production as a prerequisite for mass customization and effective manufacturing / Z. Anisic, C. Krsmanovic // Strojniski vestnik - Journal of Mechanical Engineering. - 2008. - Vol. 54, № 9. - P. 607-618.

109. Spaghetti Diagram [Электронный ресурс] // Six Sigma Material [сайт]. [2014]. URL: http://www.six-sigma-material.com/Spaghetti-Diagram.html (дата обращения 21.11.2014).

110. Синго, С. Быстрая переналадка: Революционная технология оптимизации производства / Сигео Синго; Пер. с англ. - М.: Альпина Бизнес Букс, 2006. - 344 с.

Приложение А Листинг макроса кластеризации

Sub Макрос 1()

Dim x As Integer

Dim counter As Integer

Dim i As Integer

Dim j As Integer

Dim Rowlname As String

Dim Row2name As String

Dim Row1 As Integer

Dim Row2 As Integer

Dim RowNumber As Integer

Dim ColumnNumber As Integer

Dim counter2 As Integer

Dim max As Single

Dim active As Boolean

Dim activetext As String

Dim activetemp As Boolean

Dim activetexttemp As String

Dim counter3 As Integer

Dim k As Integer

Dim l As Integer

Dim m As Integer

Dim RowNumber2 As Integer

Dim inset As Boolean

Dim criteria As Integer

Dim ListRow As Integer 'Строка начала списка'

Dim ListColumn As Integer 'Столбец начала списка'

Dim TableRow As Integer 'Строка начала таблицы'

Dim TableColumn As Integer 'Столбец начала таблицы'

Dim ListCount As Integer 'Количество элементов списка'

Dim SequenceCount As Integer 'Количество элементов последовательности'

Dim x_tr As Integer

Dim y_tr As Integer

Dim counter_tr As Integer

Dim i_tr As Integer

Dim j_tr As Integer

Dim Row1name_tr As String

Dim Row2name_tr As String

Dim Row1_tr As Integer

Dim Row2_tr As Integer

Dim RowNumber_tr As Integer

Dim ColumnNumber_tr As Integer

Dim counter2_tr As Integer

Dim max_tr As Single

Dim active_tr As Boolean

Dim activetext_tr As String

Dim activetemp_tr As Boolean

Dim activetexttemp_tr As String

Dim counter3_tr As Integer

Dim k_tr As Integer

Dim l_tr As Integer Dim m_tr As Integer Dim RowNumber2_tr As Integer Dim inset_tr As Boolean Dim criteria_tr As Integer

Dim ListRow_tr As Integer 'Строка начала списка'

Dim ListColumn_tr As Integer 'Столбец начала списка'

Dim TableRow_tr As Integer 'Строка начала таблицы'

Dim TableColumn_tr As Integer 'Столбец начала таблицы'

Dim ListCount_tr As Integer 'Количество элементов списка'

Dim SequenceCount_tr As Integer 'Количество элементов последовательности'

Worksheets('^CT1 ").Activate

Range("A1 ").Select

x = 0

RowNumber = 0 i = 1

Do Until Cells(1 + i, 1) = "" If Cells(1 + i, 1) <> "" Then RowNumber = i i = i + 1 Loop i = 1

Do Until Cells(1, 1 + i) = "" If Cells(1, 1 + i) <> "" Then ColumnNumber = i i = i + 1 Loop

ListRow = RowNumber + 4 ListColumn = 1 TableRow = ListRow TableColumn = ColumnNumber + 2

ListCount = Application.WorksheetFunction.Fact(RowNumber) / (2 * Application.WorksheetFunction.Fact(RowNumber - 2)) - 1 SequenceCount = RowNumber * 2 - 1 '------Очистка--------'

Range(Cells(ListRow - 1, ListColumn), Cells(ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1, ActiveSheet.UsedRange.Column +

ActiveSheet.UsedRange.Columns.Count - 1)).ClearContents Worksheets("Transp").Cells.ClearContents

'------Конеч очистки--------'

'------Вывод шапки--------'

Cells(ListRow - 1, 1) = "i" Cells(ListRow - 1, 2) = "j" Cells(ListRow - 1, 3) = "a" Cells(ListRow - 1, 4) = "b" Cells(ListRow - 1, 5) = "c" Cells(ListRow - 1, 6) = "d" Cells(ListRow - 1, 7) = "m"

Cells(TableRow - 1, TableColumn) = "Простое сопоставление"

'------Конец шапки--------'

counter2 = 0

For i = 1 To RowNumber For j = i + 1 To RowNumber Cells(ListRow + counter2, 1) = Cells(1 + i, 1)

Cells(ListRow + counter2, 2) = Cells(1 + j, 1) counter2 = counter2 + 1 Next j Next i

Rowl = 0 Row2 = 0

For counter = 0 To ListCount

x = 0

Rowlname = Cells(ListRow + counter, 1).Text Row2name = Cells(ListRow + counter, 2).Text For j = 0 To RowNumber

If Cells(2 + j, 1).Text = Row1name Then Row1 = 2 + j If Cells(2 + j, 1).Text = Row2name Then Row2 = 2 + j Next j

For i = 2 To ColumnNumber + 2

If (Cells(Row1, i).Value = 1) And (Cells(Row2, i).Value = 1) Then x = x + 1 Next i

Cells(ListRow + counter, 3). Value = x Next counter

Row1 = 0 Row2 = 0

For counter = 0 To ListCount

x = 0

Row1name = Cells(ListRow + counter, 1).Text Row2name = Cells(ListRow + counter, 2).Text For j = 0 To RowNumber

If Cells(2 + j, 1).Text = Row1name Then Row1 = 2 + j If Cells(2 + j, 1).Text = Row2name Then Row2 = 2 + j Next j

For i = 2 To ColumnNumber + 2

If (Cells(Row1, i).Value = 1) And (Cells(Row2, i).Value = 0) Then x = x + 1 Next i

Cells(ListRow + counter, 4). Value = x Next counter

Row1 = 0 Row2 = 0

For counter = 0 To ListCount

x = 0

Row1name = Cells(ListRow + counter, 1).Text Row2name = Cells(ListRow + counter, 2).Text For j = 0 To RowNumber

If Cells(2 + j, 1).Text = Row1name Then Row1 = 2 + j If Cells(2 + j, 1).Text = Row2name Then Row2 = 2 + j Next j

For i = 2 To ColumnNumber + 2

If (Cells(Row1, i).Value = 0) And (Cells(Row2, i).Value = 1) Then x = x + 1 Next i

Cells(ListRow + counter, 5). Value = x Next counter

Row1 = 0 Row2 = 0

For counter = 0 To ListCount

x = 0

Row1name = Cells(ListRow + counter, 1).Text Row2name = Cells(ListRow + counter, 2).Text For j = 0 To RowNumber

If Cells(2 + j, 1).Text = Row1name Then Row1 = 2 + j If Cells(2 + j, 1).Text = Row2name Then Row2 = 2 + j Next j

For i = 2 To ColumnNumber + 2

If (Cells(Row1, i).Value = 0) And (Cells(Row2, i).Value = 0) Then x = x + 1 Next i

Cells(ListRow + counter, 6). Value = x '----M-----'

Cells(ListRow + counter, 7).Value = ColumnNumber '---DISTANCE---'

Cells(ListRow + counter, TableColumn).Value = (Cells(ListRow + counter, 3).Value + Cells(ListRow + counter, 6).Value) / Cells(ListRow + counter, 7).Value Next counter

'------MAX------'

criteria = 0 max = 0 counter3 = 0 For i = 1 To ListCount

If Cells(ListRow + i, TableColumn + criteria) <> "" Then RowNumber2 = i Next i

For k = 0 To RowNumber2 If Cells(ListRow + k, TableColumn + criteria) >= max Then max = Cells(ListRow + k, TableColumn + criteria) active = 1

activetext = Cells(ListRow + k, 2).Text

Cells(ListRow + RowNumber2 + 2, TableColumn + criteria) = Cells(ListRow + k, 1).Text End If Next k

counter3 = counter3 + 1

Cells(ListRow + RowNumber2 + 2 + counter3, TableColumn + criteria) = max counter3 = counter3 + 1

Cells(ListRow + RowNumber2 + 2 + counter3, TableColumn + criteria) = activetext max = 0

For m = 0 To RowNumber - 3

max = 0

For k = 0 To RowNumber2 If (Cells(ListRow + k, TableColumn + criteria) >= max) And (Cells(ListRow + k, 2).Text = activetext) Then

inset = False

For l = 0 To SequenceCount If Cells(ListRow + RowNumber2 + 2 + l, TableColumn + criteria).Text = Cells(ListRow + k, 1).Text Then inset = True Next l

If inset = False Then

max = Cells(ListRow + k, TableColumn + criteria) activetemp = 0

activetexttemp = Cells(ListRow + k, 1).Text End If End If

If (Cells(ListRow + k, TableColumn + criteria) >= max) And (Cells(ListRow + k, 1).Text = activetext) Then

inset = False

For l = 0 To SequenceCount If Cells(ListRow + RowNumber2 + 2 + l, TableColumn + criteria).Text = Cells(ListRow + k, 2).Text Then inset = True Next l

If inset = False Then max = Cells(ListRow + k, TableColumn + criteria) activetemp = 1

activetexttemp = Cells(ListRow + k, 2).Text End If End If Next k

active = activetemp activetext = activetexttemp

Cells(ListRow + RowNumber2 + counter3 + 3, TableColumn + criteria) = max Cells(ListRow + RowNumber2 + counter3 + 4, TableColumn + criteria) = activetext counter3 = counter3 + 2 Next m

'------ТРАНСПОНИРОВАНИЕ-----'

Range(Cells(1, 1), Cells(RowNumber + 1, ColumnNumber + 1)).Copy

Worksheets("Transp").Range("A1 ").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True x_tr = 0 y_tr = 0

RowNumber_tr = 0 i_tr = 1

Do Until Worksheets("Transp").Cells(1 + i_tr, 1) = "" If Worksheets("Transp").Cells(1 + i_tr, 1) <> "" Then RowNumber_tr = i_tr i_tr = i_tr + 1 Loop i_tr = 1

Do Until Worksheets("Transp").Cells(1, 1 + i_tr) = ""

If Worksheets("Transp").Cells(1, 1 + i_tr) <> "" Then ColumnNumber_tr = i_tr

i_tr = i_tr + 1

Loop

ListRow_tr = RowNumber_tr + 4 ListColumn_tr = 1 TableRow_tr = ListRow_tr TableColumn_tr = ColumnNumber_tr + 2

'!!!!!!!!!!!' ListCount_tr = Application.WorksheetFunction.Fact(RowNumber_tr) / (2 * Application.WorksheetFunction.Fact(RowNumber_tr - 2)) - 1

ListCount_tr = Worksheets("Transp").Application.WorksheetFunction.Fact(RowNumber_tr) / (2 * Worksheets("Transp").Application.WorksheetFunction.Fact(RowNumber_tr - 2)) - 1 SequenceCount_tr = RowNumber_tr * 2 - 1 '------Конеч очистки--------'

'------Вывод шапки--------'

Worksheets("Transp").Cells(ListRow_tr - 1, 1) = "i" Worksheets("Transp").Cells(ListRow_tr - 1, 2) = "j" Worksheets("Transp").Cells(ListRow_tr - 1, 3) = "a" Worksheets("Transp").Cells(ListRow_tr - 1, 4) = "b" Worksheets("Transp").Cells(ListRow_tr - 1, 5) = "c" Worksheets("Transp").Cells(ListRow_tr - 1, 6) = "d" Worksheets("Transp").Cells(ListRow_tr - 1, 7) = "m" Worksheets("Transp").Cells(ListRow_tr - 1, 8) = "A" Worksheets("Transp").Cells(ListRow_tr - 1, 9) = "B" Worksheets("Transp").Cells(ListRow_tr - 1, 10) = "C" Worksheets("Transp").Cells(ListRow_tr - 1, 11) = "D" Worksheets("Transp").Cells(ListRow_tr - 1, 12) = "M"

Worksheets("Transp").Cells(TableRow_tr - 1, TableColumn_tr) = "Простое сопоставление"

'------Конец шапки--------'

counter2_tr = 0

For i_tr = 1 To RowNumber_tr For j_tr = i_tr + 1 To RowNumber_tr Worksheets("Transp").Cells(ListRow_tr + counter2_tr, 1) = Cells(1 + i_tr, 1) Worksheets("Transp").Cells(ListRow_tr + counter2_tr, 2) = Cells(1 + j_tr, 1) counter2_tr = counter2_tr + 1 Next j_tr Next i_tr

Row1_tr = 0 Row2_tr = 0

For counter_tr = 0 To ListCount_tr x_tr = 0

y_tr = 0

Row1name_tr = Worksheets("Transp").Cells(ListRow_tr + counter_tr, 1).Text Row2name_tr = Worksheets("Transp").Cells(ListRow_tr + counter_tr, 2).Text For j_tr = 0 To RowNumber_tr

If Worksheets("Transp").Cells(2 + j_tr, 1).Text = Row1name_tr Then Row1_tr = 2 + j_tr If Worksheets("Transp").Cells(2 + j_tr, 1).Text = Row2name_tr Then Row2_tr = 2 + j_tr Next j_tr

For i_tr = 2 To ColumnNumber_tr + 2

If (Worksheets("Transp").Cells(Row1_tr, i_tr).Value = 1) And (Worksheets("Transp").Cells(Row2_tr, i_tr).Value = 1) Then x_tr = x_tr + 1 y_tr = y_tr + 1 End If Next i_tr

Worksheets("Transp").Cells(ListRow_tr + counter_tr, 3).Value = y_tr Worksheets("Transp").Cells(ListRow_tr + counter_tr, 8).Value = x_tr Next counter_tr

Row1_tr = 0 Row2_tr = 0

For counter_tr = 0 To ListCount_tr x_tr = 0 y_tr = 0

Row1name_tr = Worksheets("Transp").Cells(ListRow_tr + counter_tr, 1).Text

Row2name_tr = Worksheets("Transp").Cells(ListRow_tr + counter_tr, 2).Text For j_tr = 0 To RowNumber_tr

If Worksheets("Transp").Cells(2 + j_tr, 1).Text = Row1name_tr Then Row1_tr = 2 + j_tr If Worksheets("Transp").Cells(2 + j_tr, 1).Text = Row2name_tr Then Row2_tr = 2 + j_tr Next j_tr

For i_tr = 2 To ColumnNumber_tr + 2

If (Worksheets("Transp").Cells(Row1_tr, i_tr).Value = 1) And (Worksheets("Transp").Cells(Row2_tr, i_tr).Value = 0) Then x_tr = x_tr + 1 y_tr = y_tr + 1 End If Next i_tr

Worksheets("Transp").Cells(ListRow_tr + counter_tr, 4).Value = y_tr Worksheets("Transp").Cells(ListRow_tr + counter_tr, 9).Value = x_tr Next counter_tr

Row1_tr = 0 Row2_tr = 0

For counter_tr = 0 To ListCount_tr x_tr = 0 y_tr = 0

Row1name_tr = Worksheets("Transp").Cells(ListRow_tr + counter_tr, 1).Text Row2name_tr = Worksheets("Transp").Cells(ListRow_tr + counter_tr, 2).Text For j_tr = 0 To RowNumber_tr

If Worksheets("Transp").Cells(2 + j_tr, 1).Text = Row1name_tr Then Row1_tr = 2 + j_tr If Worksheets("Transp").Cells(2 + j_tr, 1).Text = Row2name_tr Then Row2_tr = 2 + j_tr Next j_tr

For i_tr = 2 To ColumnNumber_tr + 2

If (Worksheets("Transp").Cells(Row1_tr, i_tr).Value = 0) And (Worksheets("Transp").Cells(Row2_tr, i_tr).Value = 1) Then x_tr = x_tr + 1 y_tr = y_tr + 1 End If Next i_tr

Worksheets("Transp").Cells(ListRow_tr + counter_tr, 5).Value = y_tr Worksheets("Transp").Cells(ListRow_tr + counter_tr, 10).Value = x_tr Next counter_tr

Row1_tr = 0 Row2_tr = 0

For counter_tr = 0 To ListCount_tr x_tr = 0 y_tr = 0

Row1name_tr = Worksheets("Transp").Cells(ListRow_tr + counter_tr, 1).Text Row2name_tr = Worksheets("Transp").Cells(ListRow_tr + counter_tr, 2).Text For j_tr = 0 To RowNumber_tr

If Worksheets("Transp").Cells(2 + j_tr, 1).Text = Row1name_tr Then Row1_tr = 2 + j_tr If Worksheets("Transp").Cells(2 + j_tr, 1).Text = Row2name_tr Then Row2_tr = 2 + j_tr Next j_tr

For i_tr = 2 To ColumnNumber_tr + 2

If (Worksheets("Transp").Cells(Row1_tr, i_tr).Value = 0) And (Worksheets("Transp").Cells(Row2_tr, i_tr).Value = 0) Then

x_tr = x_tr + 1 y_tr = y_tr + 1 End If Next i_tr

Worksheets("Transp").Cells(ListRow_tr + counter_tr, 6).Value = y_tr Worksheets("Transp").Cells(ListRow_tr + counter_tr, 11).Value = x_tr '----M-----'

Worksheets("Transp").Cells(ListRow_tr + counter_tr, 7).Value =

Worksheets("Transp").Cells(ListRow_tr + counter_tr, 3).Value + Worksheets("Transp").Cells(ListRow_tr + counter_tr, 4).Value + Worksheets("Transp").Cells(ListRow_tr + counter_tr, 5).Value + Worksheets("Transp").Cells(ListRow_tr + counter_tr, 6).Value

Worksheets("Transp").Cells(ListRow_tr + counter_tr, 12).Value =

Worksheets("Transp").Cells(ListRow_tr + counter_tr, 8).Value + Worksheets("Transp").Cells(ListRow_tr + counter_tr, 9).Value + Worksheets("Transp").Cells(ListRow_tr + counter_tr, 10).Value + Worksheets("Transp").Cells(ListRow_tr + counter_tr, 11).Value '---DISTANCE---' 'Простое сопоставление'

Worksheets("Transp").Cells(ListRow_tr + counter_tr, TableColumn_tr).Value = (Worksheets("Transp").Cells(ListRow_tr + counter_tr, 8).Value + Worksheets("Transp").Cells(ListRow_tr + counter_tr, 11).Value) / Worksheets("Transp").Cells(ListRow_tr + counter_tr, 7). Value Next counter_tr

'------MAX------'

criteria_tr = 0 max_tr = 0 counter3_tr = 0 For i_tr = 1 To ListCount_tr If Worksheets("Transp").Cells(ListRow_tr + i_tr, TableColumn_tr + criteria_tr) <> "" Then RowNumber2_tr = i_tr Next i_tr

For k_tr = 0 To RowNumber2_tr

If Worksheets("Transp").Cells(ListRow_tr + k_tr, TableColumn_tr + criteria_tr) >= max_tr

Then

max_tr = Worksheets("Transp").Cells(ListRow_tr + k_tr, TableColumn_tr + criteria_tr) active_tr = 1

activetext_tr = Worksheets("Transp").Cells(ListRow_tr + k_tr, 2).Text Worksheets("Transp").Cells(ListRow_tr + RowNumber2_tr + 2, TableColumn_tr + criteria_tr) = Worksheets("Transp").Cells(ListRow_tr + k_tr, 1).Text End If Next k_tr

counter3_tr = counter3_tr + 1

Worksheets("Transp").Cells(ListRow_tr + RowNumber2_tr + 2 + counter3_tr, TableColumn_tr + criteria_tr) = max_tr

counter3_tr = counter3_tr + 1

Worksheets("Transp").Cells(ListRow_tr + RowNumber2_tr + 2 + counter3_tr, TableColumn_tr + criteria_tr) = activetext_tr max_tr = 0

For m_tr = 0 To RowNumber_tr - 3 max_tr = 0

For k_tr = 0 To RowNumber2_tr

If (Worksheets("Transp").Cells(ListRow_tr + k_tr, TableColumn_tr + criteria_tr) >= max_tr) And (Worksheets("Transp").Cells(ListRow_tr + k_tr, 2).Text = activetext_tr) Then inset tr = False

For l_tr = 0 To SequenceCount_tr If Worksheets("Transp").Cells(ListRow_tr + RowNumber2_tr + 2 + l_tr, TableColumn_tr + criteria_tr).Text = Worksheets("Transp").Cells(ListRow_tr + k_tr, 1).Text Then inset_tr = True

Next l_tr

If inset_tr = False Then max_tr = Worksheets("Transp").Cells(ListRow_tr + k_tr, TableColumn_tr + criteria_tr) activetemp_tr = 0

activetexttemp_tr = Worksheets("Transp").Cells(ListRow_tr + k_tr, 1).Text End If End If

If (Worksheets("Transp").Cells(ListRow_tr + k_tr, TableColumn_tr + criteria_tr) >= max_tr) And (Worksheets("Transp").Cells(ListRow_tr + k_tr, 1).Text = activetext_tr) Then inset_tr = False

For l_tr = 0 To SequenceCount_tr If Worksheets("Transp").Cells(ListRow_tr + RowNumber2_tr + 2 + l_tr, TableColumn_tr + criteria_tr).Text = Worksheets("Transp").Cells(ListRow_tr + k_tr, 2).Text Then inset_tr = True

Next l_tr

If inset_tr = False Then max_tr = Worksheets("Transp").Cells(ListRow_tr + k_tr, TableColumn_tr + criteria_tr) activetemp_tr = 1

activetexttemp_tr = Worksheets("Transp").Cells(ListRow_tr + k_tr, 2).Text End If End If Next k_tr

active_tr = activetemp_tr activetext_tr = activetexttemp_tr

Worksheets("Transp").Cells(ListRow_tr + RowNumber2_tr + counter3_tr + 3, TableColumn_tr + criteria_tr) = max_tr

Worksheets("Transp").Cells(ListRow_tr + RowNumber2_tr + counter3_tr + 4, TableColumn_tr + criteria_tr) = activetext_tr

counter3_tr = counter3_tr + 2 Next m_tr

'------КОНЕЦ ТРАНСПОНИРОВАНИЯ-----'

Worksheets('^CT1 ").Activate Range("A1 ").Select

For l = 1 To RowNumber '—НЕ SequenceNum^r—' For k = 0 To RowNumber If Cells(ListRow + ListCount + 1 + (2 * l - 1), TableColumn + criteria).Text = Cells(2 + k,

1).Text Then

Range(Cells(2 + k, 1), Cells(2 + k, ColumnNumber + 1)).Copy Range(Cells(RowNumber + 2, 1), Cells(RowNumber + 2, ColumnNumber + 1))

Range(Cells(1 + l, 1), Cells(1 + l, ColumnNumber + 1)).Copy Range(Cells(2 + k, 1), Cells(2 + k, ColumnNumber + 1))

Range(Cells(RowNumber + 2, 1), Cells(RowNumber + 2, ColumnNumber + 1)).Copy Range(Cells(1 + l, 1), Cells(1 + l, ColumnNumber + 1)) End If Next k Next l

Range(Cells(RowNumber + 2, 1), Cells(RowNumber + 2, ColumnNumber + 1)).ClearContents '------Конец сортировки------'

'------Сортировка по столбцам------'

Worksheets('^Gr1 ").Activate Range("A1 ").Select

For l_tr = 1 To RowNumber_tr '—НЕ SequenceNumner—' For k_tr = 0 To RowNumber_tr If Worksheets("Transp").Cells(ListRow_tr + ListCount_tr + 1 + (2 * l_tr - 1), TableColumn_tr + criteria_tr).Text = WorksheetsC^CTryCellsd 2 + k_tr).Text Then

WorksheetsC^or! ").Range(Cells(1, 2 + k_tr), Cells(ColumnNumber_tr + 1, 2 + k_tr)).Copy Worksheets("Лист1").Range(Cells(1, RowNumber_tr + 2), Cells(ColumnNumber_tr + 1, RowNumber_tr + 2))

WorksheetsC^CTryRange^eUsO, 1 + l_tr), Cells(ColumnNumber_tr + 1, 1 + l_tr)).Copy WorksheetsC^^^ ").Range(Cells(1, 2 + k_tr), Cells(ColumnNumber_tr + 1, 2 + k_tr))

Worksheets("Лист1").Range(Cells(1, RowNumber_tr + 2), Cells(ColumnNumber_tr + 1, RowNumber_tr + 2)).Copy Worksheets("Лист1").Range(Cells(1, 1 + l_tr), Cells(ColumnNumber_tr + 1, 1 + l_tr))

End If Next k_tr Next l_tr

WorksheetsC^CTryRange^ells^, RowNumber_tr + 2), Cells(ColumnNumber_tr + 1, RowNumber_tr + 2)).ClearContents

Worksheets("Лист1 ").Activate Range("A1 ").Select

'------Конец сортировки------ '

End Sub

Приложение Б

Листинг макроса двухходовой приоритетной кластеризации

Sub Макрос1() Dim x As Integer Dim counter As Integer Dim i As Integer Dim j As Integer Dim Row1name As String Dim Row2name As String Dim Row1 As Integer Dim Row2 As Integer Dim RowNumber As Integer Dim ColumnNumber As Integer Dim counter2 As Integer Dim max As Single Dim active As Boolean Dim activetext As String Dim activetemp As Boolean Dim activetexttemp As String Dim counter3 As Integer Dim k As Integer Dim l As Integer Dim m As Integer Dim RowNumber2 As Integer Dim inset As Boolean Dim criteria As Integer

Dim ListRow As Integer 'Строка начала списка'

Dim ListColumn As Integer 'Столбец начала списка'

Dim TableRow As Integer 'Строка начала таблицы1

Dim TableColumn As Integer 'Столбец начала таблицы1

Dim ListCount As Integer 'Количество элементов списка'

Dim SequenceCount As Integer 'Количество элементов последовательности1

Dim x_tr As Integer

Dim y_tr As Integer

Dim counter_tr As Integer

Dim i_tr As Integer

Dim j_tr As Integer

Dim Row1name_tr As String

Dim Row2name_tr As String

Dim Row1_tr As Integer

Dim Row2_tr As Integer

Dim RowNumber_tr As Integer

Dim ColumnNumber_tr As Integer

Dim counter2_tr As Integer

Dim max_tr As Single

Dim active_tr As Boolean

Dim activetext_tr As String

Dim activetemp_tr As Boolean

Dim activetexttemp_tr As String

Dim counter3_tr As Integer

Dim k_tr As Integer

Dim l_tr As Integer Dim m_tr As Integer Dim RowNumber2_tr As Integer Dim inset_tr As Boolean Dim criteria_tr As Integer

Dim ListRow_tr As Integer 'Строка начала списка'

Dim ListColumn_tr As Integer 'Столбец начала списка'

Dim TableRow_tr As Integer 'Строка начала таблицы1

Dim TableColumn_tr As Integer 'Столбец начала таблицы1

Dim ListCount_tr As Integer 'Количество элементов списка'

Dim SequenceCount_tr As Integer 'Количество элементов последовательности1

Worksheets("Лист1 ")Activate

Range("A1").Select

x = 0

RowNumber = 0 i = 1

Do Until Cells(1 + i, 1) = "" IfCells(1 + i, 1) <> "" Then RowNumber=i i=i + 1 Loop i = 1

Do Until Cells(1, 1 + i) = "" IfCells(1, 1 + i) <> "" Then ColumnNumber=i i=i + 1 Loop

ListRow=RowNumber+4 ListColumn = 1 TableRow=ListRow TableColumn=ColumnNumber+2

ListCount = Application.WorksheetFunction.Fact(RowNumber) / (2 *

Application.WorksheetFunction.Fact(RowNumber - 2)) - 1 SequenceCount=RowNumber * 2 - 1 '-Очистка-'

Range(Cells(ListRow - 1, ListColumn), CeUs(ActiveSheetUsedRangeRow + ActiveSheet.UsedRange.Rows.Count - 1, ActiveSheetUsecRange.Column + ActiveSheet.UsedRange.Columns.Count -1)).CleaiContents

Worksheets("Transp").Cells.CleaiContents

'------Конеч очистки-------- '

'-Вывод шапки-'

Cells(ListRow - 1, 1) = "i" Cells(ListRow - 1, 2) = "j" Cells(ListRow - 1, 3) = "a" Cells(ListRow - 1, 4) = 'b" Cells(ListRow - 1, 5) = "c" Cells(ListRow - 1, 6) = "d" Cells(ListRow - 1, 7) = "m"

Cells(TableRow - 1, TableColumn)="Простое сопоставление"

'------Конец шапки-------- '

counter2 = 0

For i = 1 To RowNumber Forj = i + 1 To RowNumber Cells(ListRow+counter2, 1)=Cells(1 + i, 1)

Cells(ListRow+counter2, 2)=Cells(1 + j, 1) counter2=counter2 + 1 Nextj Next i

'-A-'

Row1 = 0 Row2 = 0

For counter=0 To ListCount

x=0

Row1name=Cells(ListRow+counter, 1).Text Row2name=Cells(ListRow+counter, 2).Text For j = 0 To RowNumber

IfCells(2 +j, 1).Text=Row1name Then Row1 = 2 +j If Cells(2 + j, 1).Text=Row2name Then Row2=2 + j Nextj

For i=2 To ColumnNumber+2

If(Cells(Row1, i).Value = 1) And (Cells(Row2, i).Value = 1) Then x=x + 1 Next i

Cells(ListRow+counter, 3). Value=x Next counter

'-B-'

Row1 = 0 Row2 = 0

For counter=0 To ListCcunt

x=0

Row1name=Cells(ListRow+counter, 1).Text Row2name=Cells(ListRow+counter, 2).Text For j = 0 To RowNumber

IfCells(2 +j, 1).Text=Row1name Then Row1 = 2 +j If Cells(2 + j, 1).Text=Row2name Then Row2=2 + j Nextj

For i=2 To ColumnNumber+2

If(Cells(Row1, i).Value = 1) And (Cells(Row2, i).Value=0) Then x=x + 1 Next i

Cells(ListRow+counter, 4). Value=x Next counter

'-C-'

Row1 = 0 Row2 = 0

For counter=0 To ListCount

x=0

Row1name=Cells(ListRow+counter, 1).Text Row2name=Cells(ListRow+counter, 2).Text For j = 0 To RowNumber

IfCells(2 +j, 1).Text=Row1name Then Row1 = 2 +j If Cells(2 + j, 1).Text=Row2name Then Row2=2 + j Nextj

For i=2 To ColumnNumber+2

If(Cells(Row1, i).Value=0) And (Cells(Row2, i).Value = 1) Then x=x + 1 Next i

Cells(ListRow+counter, 5). Value=x Next counter

'-D-'

Rowl = 0 Row2 = 0

For counter=0 To ListCount

x=0

Rowlname=Cells(ListRow+counter, 1).Text Row2name=Cells(ListRow+counter, 2).Text Forj = 0 To RowNumber

IfCells(2 +j, 1).Text=Rowlname Then Rowl = 2 +j If Cells(2 + j, l).Text=Row2name Then Row2=2 + j Nextj

For i=2 To ColumnNumber+2

If (Cells(Rowl, i).Value=0) And (Cells(Row2, i).Value=0) Then x=x + l Next i

Cells(ListRow+counter, 6). Value=x '—M—'

Cells(ListRow+counter, 7).Value=ColumnNumber '-DISTANCE-'

Cells(ListRow+counter, TableColumn).Value=(Cells(ListRow+counter, 3).Value+Cells(ListRow+counter, 6).Value) / Cells(ListRow+counter, 7).Value

If (Cells(Rowl, l).Interior.ColorIndex = 33) And (Cells(Row2, l).Inteiior.ColorIndex = 33) Then Cells(ListRow +counter, TableColumn).Value=Cells(42+counter, TableColumn).Value+2

If (Cells(Rowl, l).Interior.ColorIndex = 44) And (Cells(Row2, l).Interior.ColorIndex = 33) Then Cells(ListRow +counter, TableColumn).Value=Cells(42+counter, TableColumn).Value+2

If (Cells(Rowl, l).Interior.ColorIndex = 33) And (Cells(Row2, l).Inteiior.ColorIndex = 44) Then Cells(ListRow +counter, TableColumn).Value=Cells(42+counter, TableColumn).Value+2

If (Cells(Rowl, l).Interior.ColorIndex = 44) And (Cells(Row2, l).Inteiior.ColorIndex = 44) Then Cells(ListRow +counter, TableColumn).Value=Cells(42+counter, TableColumn).Value+4 Next counter

'-MAX-'

criteria=0 max = 0 counter3=0 For i = l To ListCount

IfCells(ListRow+i, TableColumn+criteria) <> "" Then RowNumber2=i Next i

For k=0 To RowNumber2 If Cells(ListRow+k, TableColumn+criteria) >= max Then max=Cells(ListRow+k, TableColumn+criteria) active = l

activetext=Cells(ListRow+k, 2).Text

Cells(ListRow+RowNumber2+2, TableColumn+criteria)=Cells(ListRow+k, l).Text End If Next k

counter3=counter3 + l

Cells(ListRow+RowNumber2+2+counter3, TableColumn+criteria)=max counter3=counter3 + l

Cells(ListRow+RowNumber2+2+counter3, TableColumn+criteria)=activetext max=0

For m = 0 To RowNumber - 3 max=0

For k = 0 To RowNumber2

If (Cells(ListRow+k, TableColumn+ciiteiia) >= max) And (Cells(ListRow+k, 2).Text=activetext) Then inset=False

For l=0 To SequenceCount If Cells(ListRow + RowNumber2 + 2 + l, TableColumn + criteria).Text = Cells(ListRow + k, 1).Text

Then inset=True

Next l

If inset=False Then max=Cells(ListRow+k, TableColumn+criteria) activetemp = 0

activetexttemp=Cells(ListRow+k, 1).Text End If End If

If (Cells(ListRow+k, TableColumn+criteria) >= max) And (Cells(ListRow+k, 1).Text=activetext) Then inset=False

For l=0 To SequenceCount If Cells(ListRow + RowNumber2 + 2 + l, TableColumn + criteria).Text = Cells(ListRow + k, 2).Text

Then inset=True

Next l

If inset=False Then max=Cells(ListRow+k, TableColumn+criteria) activetemp = 1

activetexttemp=Cells(ListRow+k, 2).Text End If End If Next k

active = activetemp activetext=activetexttemp

Cells(ListRow+RowNumber2 + counter3 + 3, TableColumn+criteria)=max Cells(ListRow+RowNumber2+counter3 + 4, TableColumn+criteria)=activetext counter3=counter3 + 2 Next m

'-ТРАНСПОНИРОВАНИЕ—'

Range(Cells(1, 1), Cells(RowNumber + 1, ColumnNumber + 1)).Copy

Worksheets("Transp").Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True x_tr=0 y_tr=0

RowNumber_tr = 0 i_tr = 1

Do Until Worksheets("Transp").Cells(1 + i_tr, 1)="" IfWorksheets("Transp").Cells(1 + i_tr, 1) <> "" Then RowNumber_tr=i_tr i_tr=i_tr + 1 Loop i_tr = 1

Do Until Worksheets("Transp").Cells(1, 1 + i_tr)="" IfWorksheets("Transp").Cells(1, 1 + i_tr) <> "" Then ColumnNumber_tr=i_tr i_tr=i_tr + 1 Loop

ListRow_tr=RowNumber_tr+4 ListColumn_tr = 1 TableRow_tr=ListRow_tr TableColumn tr=ColumnNumber tr+2

ListCount_tr = Application.WorksheetFunction.Fact(RowNumber_tr) / (2 Application.WorksheetFuinction.Fact(RowNumber_tr - 2)) - 1

ListCount_tr = Worksheets("Transp").Application.WorksheetFunction.Fact(RowNumber_tr) / (2 Worksheets("Transp").Applicalion.WorksheetFuinction.Fact(RowNumber_tr - 2)) - 1 SequenceCount_tr=RowNumber_tr * 2 - 1

'-Конеч очистки-'

'-Вывод шапки-'

Worksheets("Transp").Cells(ListRow_tr - 1, 1)="i" Worksheets("Transp").Cells(ListRow_tr - 1, 2)=" j" Worksheets("Transp").Cells(ListRow_tr - 1, 3)="a" Worksheets("Transp").Cells(ListRow_tr - 1, 4)="b" Worksheets("Transp").Cells(ListRow_tr - 1, 5)="c" Worksheets("Transp").Cells(ListRow_tr - 1, 6)="d" Worksheets("Transp").Cells(ListRow_tr - 1, 7)="m" Worksheets("Transp").Cells(ListRow_tr - 1, 8)="A" Worksheets("Transp").Cells(ListRow_tr - 1, 9)="B" Worksheets("Transp").Cells(ListRow_tr - 1, 10)="C" Worksheets("Transp").Cells(ListRow_tr - 1, 11)="D" Worksheets("Transp").Cells(ListRow_tr - 1, 12)="M"

Worksheets("Transp").Cells(TableRow_tr - 1, TableColumn_tr) = "Простое сопоставление"

'-Конец шапки-'

counter2_tr=0

For i_tr = 1 To RowNumber_tr Forj_tr=i_tr + 1 To RowNumber_tr Worksheets("Transp").Cells(ListRow_itr+counter2_tr, 1)=Cells(1 + i_tr, 1) Worksheets("Transp").Cells(ListRow_itr+counter2_tr, 2)=Cells(1 +j_tr, 1) counter2_tr = counter2_tr + 1 Nextj_tr Next i_tr

'-A-'

Row1_tr=0 Row2_tr = 0

For counter_tr=0 To ListCount_tr x_tr=0 y_tr=0

Row1name_tr=Worksheets("Transp").Cells(ListRow_tr+counter_tr, 1).Text Row2name_tr=Worksheets("Transp").Cells(ListRow_tr+counter_tr, 2).Text Forj_tr=0 To RowNumber_tr

IfWorksheets("Transp").Cells(2 +j_tr, 1).Text=Row1name_tr Then Row1_tr=2 + j_tr IfWorksheets("Transp").Cells(2 +j_tr, 1).Text=Row2name_tr Then Row2_tr=2 + j_tr Nextj_tr

For i_tr=2 To ColumnNumber_tr+2

If (Worksheets("Transp").Cells(Row1_tr, i_tr).Value = 1) And (Worksheets("Transp").Cells(Row2_tr, i_tr).Value = 1) And (Worksheets("Transp").Cells(1, i_tr).Interior.ColorIndex=43) Then x_tr=x_tr + 1 y_tr=y_tr + 1 End If

If (Worksheets("Transp").Cells(Row1_tr, i_tr).Value = 1) And (Worksheets("Transp").Cells(Row2_tr, i_tr).Value = 1) And (Worksheets("Transp").Cells(1, i_tr).Interior.ColorIndex=44) Then x_tr=x_tr+79 y_tr=y_tr + 1 End If

*

*

If (Worksheets(MTranspM).Cells(Row1_tr, i_tr).Value = 1) And (Worksheets(MTranspM).Cells(Row2_tr, i_tr).Value = 1) And (Workheets("Transp").Cells(1, i_tr).Interior.ColorIndex=33) Then x_tr=x_tr+26 y_tr=y_tr + 1 End If Next i_tr

Worteheets("Transp").Cells(ListRow_tr+counter_tr, 3).Value=y_tr Worteheets("Transp").Cells(ListRow_tr+counter_tr, 8).Value=x_tr Next counter_tr

'-B-'

Row1_tr=0 Row2_tr=0

For counter_tr=0 To ListCcunt_tr x_tr=0 y_tr=0

Row1name_tr=Worteheets("Transp").Cells(ListRow_tr+counter_tr, 1).Text Row2name_tr=Worteheets("Transp").Cells(ListRow_tr+counter_tr, 2).Text Forj_tr=0 To RowNumber_tr

IfWorksheets("Transp").Cells(2 +j_tr, 1).Text=Row1name_tr Then Row1_tr=2 + j_tr IfWorksheets("Transp").Cells(2 +j_tr, 1).Text=Row2name_tr Then Row2_tr=2 + j_tr Nextj_tr

For i_tr=2 To ColumnNumber_tr+2

If (Worksheets("Transp").Cells(Row1_tr, i_tr).Value = 1) And (Worteheets("Transp").Cells(Row2_tr, i_tr).Value=0) And (Worksheets("Transp").Cells(1, i_tr).Interior.CclorIndex=43) Then x_tr=x_tr + 1 y_tr=y_tr + 1 End If

If (Worksheets("Transp").Cells(Row1_tr, i_tr).Value = 1) And (Worteheets("Transp").Cells(Row2_tr, i_tr).Value=0) And (Worksheets("Transp").Cells(1, i_tr).Interio.CdorIndex=44) Then x_tr=x_tr+79 y_tr=y_tr + 1 End If

If (Worksheets("Transp").Cells(Row1_tr, i_tr).Value = 1) And (Worteheets("Transp").Cells(Row2_tr, i_tr).Value=0) And (Workheets("Transp").Cells(1, i_tr).Interior.CclorIndex=33) Then x_tr=x_tr+26 y_tr=y_tr + 1 End If Next i_tr

Worteheets("Transp").Cells(ListRow_tr+counter_tr, 4).Value=y_tr Worteheets("Transp").Cells(ListRow_tr+counter_tr, 9).Value=x_tr Next counter_tr

'-C-'