Таблица в excel шахматка

Содержание

  • 1 Кто обязан составлять шахматную ведомость
  • 2 Зачем нужна шахматная ведомость
  • 3 Правила оформления ведомости
  • 4 Пример составления ведомости
  • 5 После составления шахматной ведомости
  • 6 Форма шахматной оборотной ведомости
  • 7 Возможности шахматной ведомости
  • 8 Принцип составления документа на предприятии
  • 9 Проверка показателей при заполнении
  • 10 Ведомость для малых предприятий
  • 11 Отличие шахматной от оборотной ведомости
  • 12 Источники формирования данных
  • 13 Частые вопросы про шахматную ведомость
    • 13.1 Это может быть интересно:
  • 14 Как создать таблицу в Excel для чайников
    • 14.1 Как выделить столбец и строку
    • 14.2 Как изменить границы ячеек
    • 14.3 Как вставить столбец или строку
    • 14.4 Пошаговое создание таблицы с формулами
  • 15 Как создать таблицу в Excel: пошаговая инструкция
  • 16 Как работать с таблицей в Excel

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

ФАЙЛЫ
Скачать пустой бланк шахматной ведомости .xlsСкачать образец заполнения шахматной ведомости .xls

Кто обязан составлять шахматную ведомость

Заполнение шахматной ведомости является обязанностью бухгалтеров многих коммерческих структур, но при этом далеко не всех. Исключение составляют те, кто:

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

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

Зачем нужна шахматная ведомость

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

Правила оформления ведомости

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

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

Сведения в документ вносятся на основании журнала операций, в котором регистрируются все бухгалтерские проводки.

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

Пример составления ведомости

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

  1. Вначале документа заполняется «шапка»: вписывается полное наименование предприятия, а также период, за который составляется документ.
  2. Далее, необходимо обратить внимание на способ внесения сведений в таблицу ведомости. Формирование данных происходит в двух направлениях:
    • обороты по кредиту вносятся в горизонтальные строки,
    • по дебету – в вертикальные столбцы.

    Сумма, которая проводится по обоим этим счетам и ставится на пересечении соответствующей строки и столбика.

  3. В последней строке документа «Итог», в самом низу таблицы, подсчитываются все внесенные в каждый столбик суммы и указывается итоговый результат по каждому столбику в отдельности по кредитовым счетам. Аналогичным образом подсчитывается во всех строках и вписывается результат по дебетовым счетам, но только уже данные заносятся в последний вертикальный столбик.

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

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

как сделать шахматку в excel

После составления шахматной ведомости

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

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

Форма шахматной оборотной ведомости

Шахматная ведомость содержит итоговые данные корреспонденции счетов по однородным операциям. Ведомость составляется в табличной форме. Запись одного числового показатели свидетельствует одновременно о проводке по дебету и кредиту счета. Читайте также статью: → «Бухгалтерские оборотные ведомости».

Пример фрагмента шахматной ведомости приведен в таблице:

Кредит  
Дебет
2:00 200
200 100 300
300 300
350 350
200 200
350 350
100 100
300 300
200 300 300 300 200 350 100 350 2100

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

Возможности шахматной ведомости

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

Простота записи данных в документе позволяет одномоментно выявить неверный показатель, разноску по счетам с арифметическими ошибками. Наглядность учетных данных – основное достоинство формы. Одновременно шахматная ведомость не позволяет выявить ошибки в случаях:

  • отсутствия двойной записи по счетам;
  • записи неправильной проводки по счетам с одинаковыми суммами;
  • записи верной корреспонденции с неверными суммами.

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

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

При отсутствии количественной оценки (например, для счетов расчетов) ведомость, составленная с детализацией, формируется в денежном выражении.

Принцип составления документа на предприятии

Форма имеет строгую разбивку по дебету (вертикаль) и кредиту (горизонталь) счетов. В клетке пересечения производится запись суммового показателя. Данные ведомости можно расширить – использовать одновременно с учетом сальдо на начало периода и выводом остатка. Документ называется шахматным балансом и является аналогом главной книги. Порядок заполнения формы:

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

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

Проверка показателей при заполнении

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

Верно проведенная разноска исключает ошибки, что подтверждается одинаковыми итогами по вертикали и горизонтали ведомости. При формировании ведомости бухгалтер может сразу увидеть возникновение нестандартных проводок. Ряд счетов не могут иметь корреспонденций между собой. Читайте также статью: → «Форма Т-53. Платежная ведомость: образец заполнения».

При нестыковке итоговых данных необходимо проверить составляющие учета:

  • Соответствие показателей данных первичного учета разнесенным показателям.
  • Верность определения счета.
  • Наличие прикрепленной стандартной проводки к записи в журнале операций.
  • Верность проводки при использовании самостоятельно установленной двойной записи.

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

Ведомость для малых предприятий

В обороте малых предприятий, отличающихся ограниченным количеством счетов учета и незначительным числом операций, используется шахматная ведомость образца № В-9. Составление документа производится ежемесячно, с открытием документа на начало месяца. Особенность бланка состоит в расположении по вертикали счетов учета, по горизонтали – ведомостей. Нумерация и данные располагаются в порядке возрастания.

По истечении месяца производится подсчет дебетовых оборотов по счетам и кредитовые ведомостям.

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

Отличие шахматной от оборотной ведомости

При систематизации и обобщении учетных данных, кроме шахматной формы, используют оборотную ведомость. Читайте также статью: → «Форма Т-49. Расчетно-платежная ведомость». Особенности группировки данных:

  • Заполнение производится по оборотам и остаткам счетов синтетического учета.
  • Основой составления формы является итоговая запись по счетам.
  • При проверке используется принцип равенства трех пар данных – начальных, конечных остатков, оборотов по кредиту и дебету всех счетов.

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

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

Источники формирования данных

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

Предприятие при ведении учета оформило операции:

  1. Приняты на учет комплектующие, поступившие от поставщика: Дт 10 Кт 60 – 20 000 рублей;
  2. Произведена оплата за поставку комплектующих: Дт 60 Кт 51 – 20 000 рублей;
  3. Комплектующие переданы в производство: Дт 20 Кт 10 – 20 000 рублей;
  4. Начислена заработная плата рабочим: Дт 20 Кт 70 – 25 000 рублей;
  5. Выплачена заработная плата на карту: Дт 70 Кт 51 – 25 000 рублей. Вывод: итоговая сумма по кредиту и дебету совпала, операции проведены верно.
Кредит Итог
Дебет
20 000 20 000
20 000 25 000 45 000
20 000 20 000
25 000 25 000
Итог 20 000 45 000 20 000 25 000 110 000

Частые вопросы про шахматную ведомость

Вопрос №1. Используются ли при составлении «шахматки» данные, учтенные за балансом?

При составлении формы данные по забалансовым счетам не используются.

Вопрос №2. Имеется ли необходимости выведения документа на печать и хранение с документами бухгалтерского учета?

Шахматная ведомость используется для контроля верности разноски и не является обязательным документом бухгалтерского учета. Порядок хранения определяют учетные работники.

Вопрос №3. Возможно ли сократить объемность шахматной ведомости?

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

Вопрос №4. Можно ли использовать данные шахматной ведомости для анализа показателей деятельности?

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

Оцените качество статьи. Мы хотим стать лучше для вас:

Если вы не нашли ответ на свой вопрос, то вы можете получить ответ на свой вопрос позвонив по номерам ⇓

Юридическая Консультация бесплатная Москва, Московская область звоните: +7 (499) 288-17-58

Звонок в один клик

Санкт-Петербург, Ленинградская область звоните: +7 (812) 317-60-16

Звонок в один клик

Из других регионов РФ звоните: 8 (800) 550-34-98

Звонок в один клик

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

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

На пересечении определённого столба и строки ставится сумма, участвующая в проводке с этими счетами.
Внизу в последней строке проставляется сумма каждого столбца, суммы кредитуемых счетов. Эта строка имеет название «Итог». Также таблица имеет итоговый столбец, в котором отражаются суммы каждой строки, итоги дебетовых оборотов.
Количество строк и столбцов индивидуально и зависит от того, сколько в конкретной организации используется бух. счетов.
Очень легко проверятся правильность составления шахматной ведомости, итоговая строка ВСЕГДА должна равняться сумме итогового последнего столбца.

Посмотрим на примере?
За январь произведены следующие хозяйственные операции.

как сделать шахматку в excel
Как составить шахматную ведомость?

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

Начнем по плану.

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

Дом. Задание.
Составить шахматную ведомость по следующим данным. За январь в ООО «ЛУЧ» произошли следующие хоз. операции.

  1. Поступили товары от поставщика на сумму 32 000 руб.
  2. Начислена зарплата работникам торговой организации – 77 000 руб.
  3. Выданы из кассы денежные средства в размере 20 000 руб. подотчетному лицу Смирову А.В,
  4. На расчётный счет поступили денежные средства 30 000 рублей за товары от покупателей;
  5. На сумму 150 000 рублей закуплено оборудование;
  6. Оборудование введено в эксплуатацию.
  7. От Смирнова А.В. поступили товары на сумму 18 000 руб.
  8. В кассу был возвращен неиспользованный остаток денежных средств Смирновым А.В.

Все вопросы пишите в комментариях, с удовольствием помогу Вам.

Это может быть интересно:

Таблицы в Excel представляют собой ряд строк и столбцов со связанными данными, которыми вы управляете независимо друг от друга.

Работая в Excel с таблицами, вы сможете создавать отчеты, делать расчеты, строить графики и диаграммы, сортировать и фильтровать информацию.

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

Как работать в Excel с таблицами. Пошаговая инструкция

Прежде чем работать с таблицами в Эксель, последуйте рекомендациям по организации данных:

  • Данные должны быть организованы в строках и столбцах, причем каждая строка должна содержать информацию об одной записи, например о заказе;
  • Первая строка таблицы должна содержать короткие, уникальные заголовки;
  • Каждый столбец должен содержать один тип данных, таких как числа, валюта или текст;
  • Каждая строка должна содержать данные для одной записи, например, заказа. Если применимо, укажите уникальный идентификатор для каждой строки, например номер заказа;
  • В таблице не должно быть пустых строк и абсолютно пустых столбцов.

1. Выделите область ячеек для создания таблицы

как сделать шахматку в excel

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

2. Нажмите кнопку “Таблица” на панели быстрого доступа

На вкладке “Вставка” нажмите кнопку “Таблица”.

3. Выберите диапазон ячеек

как сделать шахматку в excel

В всплывающем вы можете скорректировать расположение данных, а также настроить отображение заголовков. Когда все готово, нажмите “ОК”.

4. Таблица готова. Заполняйте данными!

как сделать шахматку в excel

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

Форматирование таблицы в Excel

Для настройки формата таблицы в Экселе доступны предварительно настроенные стили. Все они находятся на вкладке “Конструктор” в разделе “Стили таблиц”:

Если 7-ми стилей вам мало для выбора, тогда, нажав на кнопку, в правом нижнем углу стилей таблиц, раскроются все доступные стили. В дополнении к предустановленным системой стилям, вы можете настроить свой формат.

Помимо цветовой гаммы, в меню “Конструктора” таблиц можно настроить:

  • Отображение строки заголовков – включает и отключает заголовки в таблице;
  • Строку итогов – включает и отключает строку с суммой значений в колонках;
  • Чередующиеся строки – подсвечивает цветом чередующиеся строки;
  • Первый столбец – выделяет “жирным” текст в первом столбце с данными;
  • Последний столбец – выделяет “жирным” текст в последнем столбце;
  • Чередующиеся столбцы – подсвечивает цветом чередующиеся столбцы;
  • Кнопка фильтра – добавляет и убирает кнопки фильтра в заголовках столбцов.

Как добавить строку или столбец в таблице Excel

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

  • Выберите пункт “Вставить” и кликните левой клавишей мыши по “Столбцы таблицы слева” если хотите добавить столбец, или “Строки таблицы выше”, если хотите вставить строку.

как сделать шахматку в excel

  • Если вы хотите удалить строку или столбец в таблице, то спуститесь по списку в сплывающем окне до пункта “Удалить” и выберите “Столбцы таблицы”, если хотите удалить столбец или “Строки таблицы”, если хотите удалить строку.

как сделать шахматку в excel

Как отсортировать таблицу в Excel

Для сортировки информации при работе с таблицей, нажмите справа от заголовка колонки “стрелочку”, после чего появится всплывающее окно:

как сделать шахматку в excel

В окне выберите по какому принципу отсортировать данные: “по возрастанию”, “по убыванию”, “по цвету”, “числовым фильтрам”.

Как отфильтровать данные в таблице Excel

Для фильтрации информации в таблице нажмите справа от заголовка колонки “стрелочку”, после чего появится всплывающее окно:

как сделать шахматку в excel

  • “Текстовый фильтр” отображается когда среди данных колонки есть текстовые значения;
  • “Фильтр по цвету” также как и текстовый, доступен когда в таблице есть ячейки, окрашенные в отличающийся от стандартного оформления цвета;
  • “Числовой фильтр” позволяет отобрать данные по параметрам: “Равно…”, “Не равно…”, “Больше…”, “Больше или равно…”, “Меньше…”, “Меньше или равно…”, “Между…”, “Первые 10…”, “Выше среднего”, “Ниже среднего”, а также настроить собственный фильтр.
  • В всплывающем окне, под “Поиском” отображаются все данные, по которым можно произвести фильтрацию, а также одним нажатием выделить все значения или выбрать только пустые ячейки.

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

Как посчитать сумму в таблице Excel

Для того чтобы посчитать сумму колонки в конце таблицы, нажмите правой клавишей мыши на любой ячейке и вызовите всплывающее окно:

В списке окна выберите пункт “Таблица” => “Строка итогов”:

Внизу таблица появится промежуточный итог. Нажмите левой клавишей мыши на ячейке с суммой.

В выпадающем меню выберите принцип промежуточного итога: это может быть сумма значений колонки, “среднее”, “количество”, “количество чисел”, “максимум”, “минимум” и т.д.

Как в Excel закрепить шапку таблицы

Таблицы, с которыми приходится работать, зачастую крупные и содержат в себе десятки строк. Прокручивая таблицу “вниз” сложно ориентироваться в данных, если не видно заголовков столбцов. В Эксель есть возможность закрепить шапку в таблице таким образом, что при прокрутке данных вам будут видны заголовки колонок.

Для того чтобы закрепить заголовки сделайте следующее:

  • Перейдите на вкладку “Вид” в панели инструментов и выберите пункт “Закрепить области”:
  • Выберите пункт “Закрепить верхнюю строку”:
  • Теперь, прокручивая таблицу, вы не потеряете заголовки и сможете легко сориентироваться где какие данные находятся:

Как перевернуть таблицу в Excel

Представим, что у нас есть готовая таблица с данными продаж по менеджерам:

На таблице сверху в строках указаны фамилии продавцов, в колонках месяцы. Для того чтобы перевернуть таблицу и разместить месяцы в строках, а фамилии продавцов нужно:

  • Выделить таблицу целиком (зажав левую клавишу мыши выделить все ячейки таблицы) и скопировать данные (CTRL+C):
  • Переместить курсор мыши на свободную ячейку и нажать правую клавишу мыши. В открывшемся меню выбрать “Специальная вставка” и нажать на этом пункте левой клавишей мыши:
  • В открывшемся окне в разделе “Вставить” выбрать “значения” и поставить галочку в пункте “транспонировать”:
  • Готово! Месяцы теперь размещены по строкам, а фамилии продавцов по колонкам. Все что остается сделать – это преобразовать полученные данные в таблицу.

В этой статье вы ознакомились с принципами работы в Excel с таблицами, а также основными подходами в их создании. Пишите свои вопросы в комментарии!

Программа Microsoft Excel удобна для составления таблиц и произведения расчетов. Рабочая область – это множество ячеек, которые можно заполнять данными. Впоследствии – форматировать, использовать для построения графиков, диаграмм, сводных отчетов.

Работа в Экселе с таблицами для начинающих пользователей может на первый взгляд показаться сложной. Она существенно отличается от принципов построения таблиц в Word. Но начнем мы с малого: с создания и форматирования таблицы. И в конце статьи вы уже будете понимать, что лучшего инструмента для создания таблиц, чем Excel не придумаешь.

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

Посмотрите внимательно на рабочий лист табличного процессора:

Это множество ячеек в столбцах и строках. По сути – таблица. Столбцы обозначены латинскими буквами. Строки – цифрами. Если вывести этот лист на печать, получим чистую страницу. Без всяких границ.

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

Как выделить столбец и строку

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

Для выделения строки – по названию строки (по цифре).

Чтобы выделить несколько столбцов или строк, щелкаем левой кнопкой мыши по названию, держим и протаскиваем.

Для выделения столбца с помощью горячих клавиш ставим курсор в любую ячейку нужного столбца – нажимаем Ctrl + пробел. Для выделения строки – Shift + пробел.

Как изменить границы ячеек

Если информация при заполнении таблицы не помещается нужно изменить границы ячеек:

  1. Передвинуть вручную, зацепив границу ячейки левой кнопкой мыши.
  2. Когда длинное слово записано в ячейку, щелкнуть 2 раза по границе столбца / строки. Программа автоматически расширит границы.
  3. Если нужно сохранить ширину столбца, но увеличить высоту строки, воспользуемся кнопкой «Перенос текста» на панели инструментов.

Для изменения ширины столбцов и высоты строк сразу в определенном диапазоне выделяем область, увеличиваем 1 столбец /строку (передвигаем вручную) – автоматически изменится размер всех выделенных столбцов и строк.

Примечание. Чтобы вернуть прежний размер, можно нажать кнопку «Отмена» или комбинацию горячих клавиш CTRL+Z. Но она срабатывает тогда, когда делаешь сразу. Позже – не поможет.

Чтобы вернуть строки в исходные границы, открываем меню инструмента: «Главная»-«Формат» и выбираем «Автоподбор высоты строки»

Для столбцов такой метод не актуален. Нажимаем «Формат» — «Ширина по умолчанию». Запоминаем эту цифру. Выделяем любую ячейку в столбце, границы которого необходимо «вернуть». Снова «Формат» — «Ширина столбца» — вводим заданный программой показатель (как правило это 8,43 — количество символов шрифта Calibri с размером в 11 пунктов). ОК.

Как вставить столбец или строку

Выделяем столбец /строку правее /ниже того места, где нужно вставить новый диапазон. То есть столбец появится слева от выделенной ячейки. А строка – выше.

Нажимаем правой кнопкой мыши – выбираем в выпадающем меню «Вставить» (или жмем комбинацию горячих клавиш CTRL+SHIFT+»=»).

Отмечаем «столбец» и жмем ОК.

Совет. Для быстрой вставки столбца нужно выделить столбец в желаемом месте и нажать CTRL+SHIFT+»=».

Все эти навыки пригодятся при составлении таблицы в программе Excel. Нам придется расширять границы, добавлять строки /столбцы в процессе работы.

Пошаговое создание таблицы с формулами

  1. Заполняем вручную шапку – названия столбцов. Вносим данные – заполняем строки. Сразу применяем на практике полученные знания – расширяем границы столбцов, «подбираем» высоту для строк.
  2. Чтобы заполнить графу «Стоимость», ставим курсор в первую ячейку. Пишем «=». Таким образом, мы сигнализируем программе Excel: здесь будет формула. Выделяем ячейку В2 (с первой ценой). Вводим знак умножения (*). Выделяем ячейку С2 (с количеством). Жмем ВВОД.
  3. Когда мы подведем курсор к ячейке с формулой, в правом нижнем углу сформируется крестик. Он указываем на маркер автозаполнения. Цепляем его левой кнопкой мыши и ведем до конца столбца. Формула скопируется во все ячейки.
  4. Обозначим границы нашей таблицы. Выделяем диапазон с данными. Нажимаем кнопку: «Главная»-«Границы» (на главной странице в меню «Шрифт»). И выбираем «Все границы».

Теперь при печати границы столбцов и строк будут видны.

С помощью меню «Шрифт» можно форматировать данные таблицы Excel, как в программе Word.

Поменяйте, к примеру, размер шрифта, сделайте шапку «жирным». Можно установить текст по центру, назначить переносы и т.д.

Как создать таблицу в Excel: пошаговая инструкция

Простейший способ создания таблиц уже известен. Но в Excel есть более удобный вариант (в плане последующего форматирования, работы с данными).

Сделаем «умную» (динамическую) таблицу:

  1. Переходим на вкладку «Вставка» — инструмент «Таблица» (или нажмите комбинацию горячих клавиш CTRL+T).
  2. В открывшемся диалоговом окне указываем диапазон для данных. Отмечаем, что таблица с подзаголовками. Жмем ОК. Ничего страшного, если сразу не угадаете диапазон. «Умная таблица» подвижная, динамическая.

Примечание. Можно пойти по другому пути – сначала выделить диапазон ячеек, а потом нажать кнопку «Таблица».

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

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

Как работать с таблицей в Excel

С выходом новых версий программы работа в Эксель с таблицами стала интересней и динамичней. Когда на листе сформирована умная таблица, становится доступным инструмент «Работа с таблицами» — «Конструктор».

Здесь мы можем дать имя таблице, изменить размер.

Доступны различные стили, возможность преобразовать таблицу в обычный диапазон или сводный отчет.

Возможности динамических электронных таблиц MS Excel огромны. Начнем с элементарных навыков ввода данных и автозаполнения:

  1. Выделяем ячейку, щелкнув по ней левой кнопкой мыши. Вводим текстовое /числовое значение. Жмем ВВОД. Если необходимо изменить значение, снова ставим курсор в эту же ячейку и вводим новые данные.
  2. При введении повторяющихся значений Excel будет распознавать их. Достаточно набрать на клавиатуре несколько символов и нажать Enter.
  3. Чтобы применить в умной таблице формулу для всего столбца, достаточно ввести ее в одну первую ячейку этого столбца. Программа скопирует в остальные ячейки автоматически.
  4. Для подсчета итогов выделяем столбец со значениями плюс пустая ячейка для будущего итога и нажимаем кнопку «Сумма» (группа инструментов «Редактирование» на закладке «Главная» или нажмите комбинацию горячих клавиш ALT+»=»).

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

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

Источник
 

Добрый день!
Прошу помощи в преобразовании данных в специфическую таблицу (шахматку)
Пробовал делать через power power query, ничего не получилось.
Вижу как вариант такой макрос который последовательно из одной созданной сводной таблицы, перебирает диапазон и копирую очередную выборку заполняет шахматку.
Каждый этаж выстраивается выборками друг за другом, потом на уровень ниже заполняется другой этаж.
Пример заполненной шахматки  на листе «Шахматка». Исходный массив на листе «Диапазон»

Изменено: Айдар Ситдиков — 18.08.2021 11:10:29
 

DemonAMT

Пользователь

Сообщений: 420
Регистрация: 24.01.2020

Добрый день!
А обычная сводная не подойдет?

Изменено: DemonAMT — 18.08.2021 12:16:50
 

voltron

Пользователь

Сообщений: 8
Регистрация: 18.08.2021

В том то и дело. что нет. нужен вот такой вид (картинка)

P.S. думаю может все-таки как-то через PQ попытаться что-то сварганить по аналогии с

https://www.planetaexcel.ru/techniques/2/15810/  
 

Mershik

Пользователь

Сообщений: 8277
Регистрация: 03.12.2015

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

Не бойтесь совершенства. Вам его не достичь.

 

МатросНаЗебре

Пользователь

Сообщений: 5516
Регистрация: 05.02.2014

#5

18.08.2021 13:05:49

Код 
Sub Этажи()
    Dim y1 As Long
    Dim y2 As Long
    Dim u As Long
    Dim x As Long
    Dim k As Long
    Dim h As Long
    Dim j As Long
    Dim arrA As Variant
    Dim arDE As Variant
    Dim sFloor As String
    Dim v As Variant
    
    Dim shD As Worksheet
    Set shD = Sheets("Диапазон")
    Dim shS As Worksheet
    Set shS = Sheets("Шахматка")
    shS.Select
    shS.Cells.Clear
    With shD
        y1 = .Cells(.Rows.Count, 1).End(xlUp).Row
        arrA = .Range(.Cells(1, 1), .Cells(y1, "E"))
    End With
    
    u = 2
    
    For y1 = 3 To UBound(arrA, 1)
        If arrA(y1, 1) <> "" Then
            If sFloor <> arrA(y1, 1) Then
                j = 1
                For k = 2 To x - 1 Step 2
                    shS.Cells(u + h + 1, k + 0).Value = "S жилая"
                    shS.Cells(u + h + 2, k + 0).Value = "S общая (без л.п.) "
                    shS.Cells(u + h + 3, k + 0).Value = "S общая"
                    shS.Cells(u + h + 2, k + 1).FormulaR1C1 = Application.ConvertFormula("=SUM(R" & u & "C:R" & u + h - 1 & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 1, k + 1))
                    shS.Cells(u + h + 3, k + 1).FormulaR1C1 = Application.ConvertFormula("=SUM(R" & u & "C:R" & u + h - 1 & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 2, k + 1))
                    shS.Cells(u + h + 4, k + 1).Value = j: j = j + 1
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).Merge
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).Font.Bold = True
                    shS.Cells(u + 0 + 0, k + 0).Resize(1, 2).Merge
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).HorizontalAlignment = xlCenter
                    shS.Cells(u + 0 + 0, k + 0).Resize(1, 2).HorizontalAlignment = xlCenter
                    shS.Cells(u + 0 + 0, k + 0).EntireColumn.ColumnWidth = 19.86
                    shS.Cells(u + 0 + 0, k + 1).EntireColumn.ColumnWidth = 10.14
                    
                    
                    With shS.Cells(u + 0 + 0, k + 0).Resize(h + 5, 2)
                        For Each v In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
                            With .Borders(v)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlMedium
                            End With
                        Next
                        For Each v In Array(xlInsideVertical, xlInsideHorizontal)
                            With .Borders(v)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                        Next
                        With .Rows(1)
                            .Font.Bold = True
                            With .Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .ThemeColor = xlThemeColorAccent3
                                .TintAndShade = 0.799981688894314
                                .PatternTintAndShade = 0
                            End With
                        End With
                    End With
                    
                    With shS.Cells(u + h + 1, k + 0).Resize(3, 2).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 15204351
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    With shS.Cells(u + h + 3, k + 1).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 5296274
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                Next
            
                sFloor = arrA(y1, 1)
                
                If h > 0 Then
                    shS.Cells(u, 1).Resize(h + 5).Merge
                End If
                u = u + h + 5
                shS.Cells(u, 1).Value = arrA(y1, 1)
                shS.Cells(u, 1).VerticalAlignment = xlCenter
                
                x = 2
                h = 1
            End If
            
            y2 = y1
            Do
                If y2 = UBound(arrA, 1) Then Exit Do
                If arrA(y2 + 1, 1) = "" Then Exit Do
                y2 = y2 + 1
            Loop
                
            arDE = shD.Cells(y1, "D").Resize(y2 - y1 + 1, 2)
            shS.Cells(u + 1, x).Resize(UBound(arDE, 1), UBound(arDE, 2)) = arDE
            If h < UBound(arDE, 1) Then h = UBound(arDE, 1)
            x = x + UBound(arDE, 2)
            y1 = y2
        End If
    Next
End Sub

Изменено: МатросНаЗебре — 18.08.2021 13:10:39
 

voltron

Пользователь

Сообщений: 8
Регистрация: 18.08.2021

МатросНаЗебре, обалдеть  8-0  как так быстро можно собрать код…
честно просто потрясен… :cry:
Все супер!!!
Могу попросить сделать кое-что
1. Брать в обработку только начинающиеся с ’Квартира» (из столбца без названия)
2. Подсчитывать S жилая из столбца «_Жилая площадь» (сейчас не считатет)
3. Выборку из «_Номер секции» вставлять в отдельный блок с разрывом, чтобы я туда мог втащить формулы подсчета итогов по секции. Или если это несложно зашить в код)
4. в зависимости от кол-ва элементов с ненулевой площадью подписывать кол-во комнат в квартире
5. сделать сквозную нумерацию квартир, а не поэтажно как это реализовано у вас сейчас.
6. если возможно сделать унификацию для повторяющихся квартир, без создания таблиц(выборок), а просто порядковый номер (есть пример в файле). но думаю это уже долго ибо требуется анализ сравнение…

Прикрепленные файлы

  • Скрин2.gif (130.66 КБ)

Изменено: voltron — 18.08.2021 15:30:22
 

МатросНаЗебре

Пользователь

Сообщений: 5516
Регистрация: 05.02.2014

#7

18.08.2021 17:58:06

Код 
Option Explicit

Sub Этажи()
    Dim Application_Calculation As Long
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual

    Dim y1 As Long
    Dim y2 As Long
    Dim y3 As Long
    Dim u As Long
    Dim x As Long
    Dim k As Long
    Dim h As Long
    Dim sKvNo As String
    Dim nKomInKv As Long
    Dim arrA As Variant
    Dim arDE As Variant
    Dim sFloor As String
    Dim sSection As String
    Dim v As Variant
    Dim s As String
    Dim sL1 As String
    Dim sL2 As String
    Dim sObSlp As String
    Dim sObBlp As String
    Dim sJil As String
    Dim arrNkom As Variant
    ReDim arrNkom(1 To 3, 1 To 1)
    Dim arrNomKv As Variant
    ReDim arrNomKv(1 To 1, 1 To 10000)
    
    Dim shD As Worksheet
    Set shD = Sheets("Диапазон")
    Dim shS As Worksheet
    Set shS = Sheets("Шахматка")
    shS.Select
    shS.Cells.Clear
    With shD
        y1 = .Cells(.Rows.Count, 1).End(xlUp).Row + 2
        arrA = .Range(.Cells(1, 1), .Cells(y1, "I"))
    End With
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim dicL As Object
    Set dicL = CreateObject("Scripting.Dictionary")
    
    u = 2
'    j = 0
    
    For y1 = 3 To UBound(arrA, 1) - 2
        If arrA(y1, 1) <> "" Then
        'If Left(arrA(y1, 2), Len("Квартира")) = "Квартира" Then
            If sFloor <> arrA(y1, 1) Then
                shS.Cells(u + h + 4, 1).Resize(1, UBound(arrNomKv, 2)) = arrNomKv
                For k = 2 To x - 1 Step 2
                    shS.Cells(u + h + 1, k + 0).Value = "S жилая"
                    shS.Cells(u + h + 2, k + 0).Value = "S общая (без л.п.) "
                    shS.Cells(u + h + 3, k + 0).Value = "S общая"
                    shS.Cells(u + h + 2, k + 1).FormulaR1C1 = Application.ConvertFormula("=SUM(R" & u + 1 & "C:R" & u + h & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 2, k + 1))
                    sObBlp = sObBlp & "+" & Cells(u + h + 2, k + 1).Address(0, 0)
                    shS.Cells(u + h + 3, k + 1).FormulaR1C1 = Application.ConvertFormula("=SUM(R" & u + 1 & "C:R" & u + h & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 3, k + 1))
                    sObSlp = sObSlp & "+" & Cells(u + h + 3, k + 1).Address(0, 0)
'                    j = j + 1
                    'shS.Cells(u + h + 4, k + 1).Value = j
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).Merge
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).Font.Bold = True
                    shS.Cells(u + 0 + 0, k + 0).Resize(1, 2).Merge
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).HorizontalAlignment = xlCenter
                    shS.Cells(u + 0 + 0, k + 0).Resize(1, 2).HorizontalAlignment = xlCenter
                    shS.Cells(u + 0 + 0, k + 0).EntireColumn.ColumnWidth = 19.86
                    shS.Cells(u + 0 + 0, k + 1).EntireColumn.ColumnWidth = 10.14
                    
                    With shS.Cells(u + 0 + 0, k + 0).Resize(h + 5, 2)
                        For Each v In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
                            With .Borders(v)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlMedium
                            End With
                        Next
                        For Each v In Array(xlInsideVertical, xlInsideHorizontal)
                            With .Borders(v)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                        Next
                        With .Rows(1)
                            .Font.Bold = True
                            With .Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .ThemeColor = xlThemeColorAccent3
                                .TintAndShade = 0.799981688894314
                                .PatternTintAndShade = 0
                            End With
                        End With
                    End With
                    
                    With shS.Cells(u + h + 1, k + 0).Resize(3, 2).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 15204351
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    With shS.Cells(u + h + 3, k + 1).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 5296274
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    
                    nKomInKv = 0
                    s = ""
                    sL1 = ""
                    For y3 = u + 1 To u + h
                        If dic.Exists(Cells(y3, k + 1).Address(0, 0)) Then
                            s = s & "+R" & y3 & "C"
                            sJil = sJil & "+" & Cells(y3, k + 1).Address(0, 0)
                            nKomInKv = nKomInKv + 1
                        End If
                        If dicL.Exists(Cells(y3, k + 1).Address(0, 0)) Then
                            sL1 = sL1 & "+R" & y3 & "C"
                            sL2 = sL2 & "+" & Cells(y3, k + 1).Address(0, 0)
                        End If
                    Next
                    If s <> "" Then
                        s = Mid(s, 2, Len(s) - 1)
                        s = "=" & s
                        s = Application.ConvertFormula(s, xlR1C1, xlR1C1, xlRelative, Cells(u + h + 1, k + 1))
                        shS.Cells(u + h + 1, k + 1).FormulaR1C1 = s 'Application.ConvertFormula("=SUM(R" & u & "C:R" & u + h - 1 & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 1, k + 1))
                    End If
                    If sL1 <> "" Then
                        sL1 = Mid(sL1, 2, Len(sL1) - 1)
                        sL1 = Application.ConvertFormula(sL1, xlR1C1, xlR1C1, xlRelative, Cells(u + h + 2, k + 1))
                        With shS.Cells(u + h + 2, k + 1)
                            .FormulaR1C1 = .FormulaR1C1 & "-" & sL1
                        End With
                    End If
                    If nKomInKv > 0 And nKomInKv < 4 Then
                        arrNkom(nKomInKv, 1) = arrNkom(nKomInKv, 1) + 1
                    End If
                    
                Next
            
                sFloor = arrA(y1, 1)
                ReDim arrNomKv(1 To 1, 1 To 10000)
                
                If h > 0 Then
                    shS.Cells(u, 1).Resize(h + 5).Merge
                End If
                
                
                '--------------------------------
                If arrA(y1 + 2, 9) <> "" Then
                    If sSection <> arrA(y1 + 2, 9) Then
                        If sSection <> "" Then
                            u = u + 10
                            With shS.Cells(u + 2, 2).Resize(6)
                                .Value = Application.Transpose(Array("ИТОГО ПО СЕКЦИИ:", "", "1. S общая(с л.п.)", "2. S общая(б.л.п.)", "3. S жил.", "4. S летн."))
                                .Font.Bold = True
                            End With
                            If sObSlp <> "" Then
                                sObSlp = Mid(sObSlp, 2, Len(sObSlp) - 1)
                                sObSlp = "=" & sObSlp
                                With shS.Cells(u + 4, 4)
                                    .Formula = sObSlp
                                    .Font.Bold = True
                                End With
                                sObSlp = ""
                            End If
                            If sObBlp <> "" Then
                                sObBlp = Mid(sObBlp, 2, Len(sObBlp) - 1)
                                sObBlp = "=" & sObBlp
                                With shS.Cells(u + 5, 4)
                                    .Formula = sObBlp
                                    .Font.Bold = True
                                End With
                                sObBlp = ""
                            End If
                            If sJil <> "" Then
                                sJil = Mid(sJil, 2, Len(sJil) - 1)
                                sJil = "=" & sJil
                                With shS.Cells(u + 6, 4)
                                    .Formula = sJil
                                    .Font.Bold = True
                                End With
                                sJil = ""
                            End If
                            
                            If sL2 <> "" Then
                                sL2 = Mid(sL2, 2, Len(sL2) - 1)
                                sL2 = "=" & sL2
                                With shS.Cells(u + 7, 4)
                                    .Formula = sL2
                                    .Font.Bold = True
                                End With
                                sL2 = ""
                            End If
                            
                            
                            With shS.Cells(u + 4, 5).Resize(4)
                                .Value = "м2"
                                .Font.Bold = True
                            End With
                            With shS.Cells(u + 4, 6).Resize(3)
                                .Value = Application.Transpose(Array("1-к кв.", "2-к кв.", "3-к кв."))
                            End With
                            shS.Cells(u + 4, 7).Resize(UBound(arrNkom, 1)) = arrNkom
                            ReDim arrNkom(1 To 3, 1 To 1)
                        End If
                        sSection = arrA(y1, 9)
                        
                    End If
                End If
                
                
                
                u = u + h + 5
'                shS.Cells(u, 1).Value = arrA(y1, 1)
'                shS.Cells(u, 1).VerticalAlignment = xlCenter
                
                x = 2
                h = 1
            End If
            
            y2 = y1
            k = 0
            Do
                If y2 = UBound(arrA, 1) Then Exit Do
                If arrA(y2 + 1, 1) = "" Then Exit Do
                
                k = k + 1
                If arrA(y2 + 1, 7) > 0 Then
                    dic.Item(Cells(u + k + 1, x + 1).Address(0, 0)) = 0
                End If
                
                y2 = y2 + 1
            Loop
                            
                            
            y2 = y1
            k = 0
            Do
                If y2 = UBound(arrA, 1) Then Exit Do
                If arrA(y2 + 1, 1) = "" Then Exit Do
                
                k = k + 1
                Select Case arrA(y2 + 1, 4)
                Case "Терраса", "Лоджия", "Балкон", "Кухня -ниша", "Лоджия в теплом контуре"
                    dicL.Item(Cells(u + k + 1, x + 1).Address(0, 0)) = 0
                End Select
                
                y2 = y2 + 1
            Loop
                            
                            
                            
                            
            If Left(arrA(y1, 2), Len("Квартира")) = "Квартира" Then
                shS.Cells(u, 1).Value = arrA(y1, 1)
                shS.Cells(u, 1).VerticalAlignment = xlCenter
            
                arDE = shD.Cells(y1, "D").Resize(y2 - y1 + 1, 2)
                shS.Cells(u + 1, x).Resize(UBound(arDE, 1), UBound(arDE, 2)) = arDE
                If h < UBound(arDE, 1) Then h = UBound(arDE, 1)
                arrNomKv(1, x) = arrA(y1, 2)
                x = x + UBound(arDE, 2)
                'sKvNo = arrA(y1, 2)
            End If
            
            y1 = y2
        End If
    Next
    
    Application.Calculation = Application_Calculation
End Sub
 

voltron

Пользователь

Сообщений: 8
Регистрация: 18.08.2021

Великолепно!
Спасибо огромное за проделанную работу и уделенное время!!!!  :)

Если это возможно поправьте пожалуйста:
1. В зависимости от кол-ва элементов с ненулевой площадью подписывать кол-во комнат в квартире
2. Вместо наименования квартиры внести порядковый номер
3. Искусственно ввел новые БС и их не корректно обработал код.
 

МатросНаЗебре

Пользователь

Сообщений: 5516
Регистрация: 05.02.2014

#9

19.08.2021 10:13:59

Код 
Sub ТретийЭтаж()
    Dim Application_Calculation As Long
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual

    Dim y1 As Long
    Dim y2 As Long
    Dim y3 As Long
    Dim u As Long
    Dim x As Long
    Dim k As Long
    Dim h As Long
    Dim j As Long
    Dim nKomInKv As Long
    Dim arrA As Variant
    Dim arDE As Variant
    Dim sFloor As String
    Dim sSection As String
    Dim v As Variant
    Dim s As String
    Dim sL1 As String
    Dim sL2 As String
    Dim sObSlp As String
    Dim sObBlp As String
    Dim sJil As String
    Dim sL2D As String
    Dim sObSlpD As String
    Dim sObBlpD As String
    Dim sJilD As String
    Dim s1kD As String
    
    Dim arrNkom As Variant
    ReDim arrNkom(1 To 3, 1 To 1)
    
    Dim arrSkom As Variant
    ReDim arrSkom(1 To 3, 1 To 1)
    
    Dim shD As Worksheet
    Set shD = Sheets("Диапазон")
    Dim shS As Worksheet
    Set shS = Sheets("Шахматка")
    shS.Select
    shS.Cells.Clear
    With shD
        y1 = .Cells(.Rows.Count, 1).End(xlUp).Row + 2
        arrA = .Range(.Cells(1, 1), .Cells(y1, "I"))
    End With
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim dicL As Object
    Set dicL = CreateObject("Scripting.Dictionary")
    
    u = 2
    j = 0
    
    For y1 = 3 To UBound(arrA, 1) - 2
        If arrA(y1, 1) <> "" Or (y1 >= UBound(arrA, 1) - 2) Then
        
        'If Left(arrA(y1, 2), Len("Квартира")) = "Квартира" Then
            If sFloor <> arrA(y1, 1) Then
                For k = 2 To x - 1 Step 2
                    shS.Cells(u + h + 1, k + 0).Value = "S жилая"
                    shS.Cells(u + h + 2, k + 0).Value = "S общая (без л.п.) "
                    shS.Cells(u + h + 3, k + 0).Value = "S общая"
                    shS.Cells(u + h + 2, k + 1).FormulaR1C1 = Application.ConvertFormula("=SUM(R" & u + 1 & "C:R" & u + h & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 2, k + 1))
                    sObBlp = sObBlp & "+" & Cells(u + h + 2, k + 1).Address(0, 0)
                    shS.Cells(u + h + 3, k + 1).FormulaR1C1 = Application.ConvertFormula("=SUM(R" & u + 1 & "C:R" & u + h & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 3, k + 1))
                    sObSlp = sObSlp & "+" & Cells(u + h + 3, k + 1).Address(0, 0)
                    j = j + 1
                    shS.Cells(u + h + 4, k + 1).Value = j
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).Merge
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).Font.Bold = True
                    shS.Cells(u + 0 + 0, k + 0).Resize(1, 2).Merge
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).HorizontalAlignment = xlCenter
                    shS.Cells(u + 0 + 0, k + 0).Resize(1, 2).HorizontalAlignment = xlCenter
                    shS.Cells(u + 0 + 0, k + 0).EntireColumn.ColumnWidth = 19.86
                    shS.Cells(u + 0 + 0, k + 1).EntireColumn.ColumnWidth = 10.14
                    
                    With shS.Cells(u + 0 + 0, k + 0).Resize(h + 5, 2)
                        For Each v In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
                            With .Borders(v)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlMedium
                            End With
                        Next
                        For Each v In Array(xlInsideVertical, xlInsideHorizontal)
                            With .Borders(v)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                        Next
                        With .Rows(1)
                            .Font.Bold = True
                            With .Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .ThemeColor = xlThemeColorAccent3
                                .TintAndShade = 0.799981688894314
                                .PatternTintAndShade = 0
                            End With
                        End With
                    End With
                    
                    With shS.Cells(u + h + 1, k + 0).Resize(3, 2).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 15204351
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    With shS.Cells(u + h + 3, k + 1).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 5296274
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    
                    nKomInKv = 0
                    s = ""
                    sL1 = ""
                    For y3 = u + 1 To u + h
                        If dic.Exists(Cells(y3, k + 1).Address(0, 0)) Then
                            s = s & "+R" & y3 & "C"
                            sJil = sJil & "+" & Cells(y3, k + 1).Address(0, 0)
                            nKomInKv = nKomInKv + 1
                        End If
                        If dicL.Exists(Cells(y3, k + 1).Address(0, 0)) Then
                            sL1 = sL1 & "+R" & y3 & "C"
                            sL2 = sL2 & "+" & Cells(y3, k + 1).Address(0, 0)
                        End If
                    Next
                    If s <> "" Then
                        s = Mid(s, 2, Len(s) - 1)
                        s = "=" & s
                        s = Application.ConvertFormula(s, xlR1C1, xlR1C1, xlRelative, Cells(u + h + 1, k + 1))
                        shS.Cells(u + h + 1, k + 1).FormulaR1C1 = s 'Application.ConvertFormula("=SUM(R" & u & "C:R" & u + h - 1 & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 1, k + 1))
                    End If
                    If sL1 <> "" Then
                        sL1 = Mid(sL1, 2, Len(sL1) - 1)
                        sL1 = Application.ConvertFormula(sL1, xlR1C1, xlR1C1, xlRelative, Cells(u + h + 2, k + 1))
                        With shS.Cells(u + h + 2, k + 1)
                            .FormulaR1C1 = .FormulaR1C1 & "-" & sL1
                        End With
                    End If
                    If nKomInKv > 0 And nKomInKv < 4 Then
                        arrNkom(nKomInKv, 1) = arrNkom(nKomInKv, 1) + 1
                        arrSkom(nKomInKv, 1) = arrSkom(nKomInKv, 1) + shS.Cells(u + h + 3, k + 1).Value
                        shS.Cells(u + 0 + 0, k + 0).Value = nKomInKv
                    End If
                    
                Next
                sFloor = arrA(y1, 1)
                
                If h > 1 Then
                    shS.Cells(u, 1).Resize(h + 5).Merge
                End If
                If h > 1 Then u = u + h + 5
                
                
                '--------------------------------
                If arrA(y1, 9) <> "" Or (y1 >= UBound(arrA, 1) - 2) Then
                    If sSection <> arrA(y1, 9) Then
                        If sSection <> "" Then
                            'u = u + 10
                            With shS.Cells(u + 2, 2).Resize(6)
                                .Value = Application.Transpose(Array("ИТОГО ПО СЕКЦИИ:", "", "1. S общая(с л.п.)", "2. S общая(б.л.п.)", "3. S жил.", "4. S летн."))
                                .Font.Bold = True
                            End With
                            If sObSlp <> "" Then
                                sObSlp = Mid(sObSlp, 2, Len(sObSlp) - 1)
                                sObSlp = "=" & sObSlp
                                With shS.Cells(u + 4, 4)
                                    .Formula = sObSlp
                                    .Font.Bold = True
                                    sObSlpD = sObSlpD & "+" & .Address(0, 0)
                                End With
                                sObSlp = ""
                            End If
                            If sObBlp <> "" Then
                                sObBlp = Mid(sObBlp, 2, Len(sObBlp) - 1)
                                sObBlp = "=" & sObBlp
                                With shS.Cells(u + 5, 4)
                                    .Formula = sObBlp
                                    .Font.Bold = True
                                    sObBlpD = sObBlpD & "+" & .Address(0, 0)
                                End With
                                sObBlp = ""
                            End If
                            If sJil <> "" Then
                                sJil = Mid(sJil, 2, Len(sJil) - 1)
                                sJil = "=" & sJil
                                With shS.Cells(u + 6, 4)
                                    .Formula = sJil
                                    .Font.Bold = True
                                    sJilD = sJilD & "+" & .Address(0, 0)
                                End With
                                sJil = ""
                            End If

                            If sL2 <> "" Then
                                sL2 = Mid(sL2, 2, Len(sL2) - 1)
                                sL2 = "=" & sL2
                                With shS.Cells(u + 7, 4)
                                    .Formula = sL2
                                    .Font.Bold = True
                                    sL2D = sL2D & "+" & .Address(0, 0)
                                End With
                                sL2 = ""
                            End If


                            With shS.Cells(u + 4, 5).Resize(4)
                                .Value = "м2"
                                .Font.Bold = True
                            End With
                            With shS.Cells(u + 4, 6).Resize(3)
                                .Value = Application.Transpose(Array("1-к кв.", "2-к кв.", "3-к кв."))
                            End With
                            With shS.Cells(u + 4, 7)
                                .Resize(UBound(arrNkom, 1)) = arrSkom
                                s1kD = s1kD & "+" & .Address(0, 0)
                            End With
                            With shS.Cells(u + 4, 8)
                                .Resize(UBound(arrNkom, 1)) = arrNkom
                                's1kD = s1kD & "+" & .Address(0, 0)
                            End With
                            ReDim arrNkom(1 To 3, 1 To 1)
                            ReDim arrSkom(1 To 3, 1 To 1)
                            u = u + 10
                        End If
                        sSection = arrA(y1, 9)
                            
                    End If
                End If
                '--------------------------------
'
                
                
'                u = u + h + 5
'                shS.Cells(u, 1).Value = arrA(y1, 1)
'                shS.Cells(u, 1).VerticalAlignment = xlCenter
                
                x = 2
                h = 1
            End If
            
            y2 = y1
            k = 0
            Do
                If y2 = UBound(arrA, 1) Then Exit Do
                If arrA(y2 + 1, 1) = "" Then Exit Do
                
                k = k + 1
                If arrA(y2 + 1, 7) > 0 Then
                    dic.Item(Cells(u + k + 1, x + 1).Address(0, 0)) = 0
                End If
                
                y2 = y2 + 1
            Loop
                            
                            
            y2 = y1
            k = 0
            Do
                If y2 = UBound(arrA, 1) Then Exit Do
                If arrA(y2 + 1, 1) = "" Then Exit Do
                
                k = k + 1
                Select Case arrA(y2 + 1, 4)
                Case "Терраса", "Лоджия", "Балкон", "Кухня -ниша", "Лоджия в теплом контуре"
                    dicL.Item(Cells(u + k + 1, x + 1).Address(0, 0)) = 0
                End Select
                
                y2 = y2 + 1
            Loop
                            
                            
                            
                            
            If Left(arrA(y1, 2), Len("Квартира")) = "Квартира" Then
                shS.Cells(u, 1).Value = arrA(y1, 1)
                shS.Cells(u, 1).VerticalAlignment = xlCenter
            
                arDE = shD.Cells(y1, "D").Resize(y2 - y1 + 1, 2)
                shS.Cells(u + 1, x).Resize(UBound(arDE, 1), UBound(arDE, 2)) = arDE
                If h < UBound(arDE, 1) Then h = UBound(arDE, 1)
                x = x + UBound(arDE, 2)
            End If
            
'            If arrA(y1 + 2, 9) <> "" Then
'                If sSection <> arrA(y1 + 2, 9) Then
'                    If sSection <> "" Then
'                        u = u + 10
'                    End If
'
'                    sSection = arrA(y1, 9)
'                End If
'            End If
            
            y1 = y2
        End If
    Next
    
    
    '------------------------------------------------------
    With shS.Cells(u + 2, 2).Resize(6)
        .Value = Application.Transpose(Array("ИТОГО ПО ДОМУ:", "", "1. S общая(с л.п.)", "2. S общая(б.л.п.)", "3. S жил.", "4. S летн."))
        .Font.Bold = True
    End With
    If sObSlpD <> "" Then
        sObSlpD = Mid(sObSlpD, 2, Len(sObSlpD) - 1)
        sObSlpD = "=" & sObSlpD
        With shS.Cells(u + 4, 4)
            .Formula = sObSlpD
            .Font.Bold = True
        End With
        sObSlp = ""
    End If
    If sObBlpD <> "" Then
        sObBlpD = Mid(sObBlpD, 2, Len(sObBlpD) - 1)
        sObBlpD = "=" & sObBlpD
        With shS.Cells(u + 5, 4)
            .Formula = sObBlpD
            .Font.Bold = True
        End With
        sObBlp = ""
    End If
    If sJilD <> "" Then
        sJilD = Mid(sJilD, 2, Len(sJilD) - 1)
        sJilD = "=" & sJilD
        With shS.Cells(u + 6, 4)
            .Formula = sJilD
            .Font.Bold = True
        End With
        sJil = ""
    End If

    If sL2D <> "" Then
        sL2D = Mid(sL2D, 2, Len(sL2D) - 1)
        sL2D = "=" & sL2D
        With shS.Cells(u + 7, 4)
            .Formula = sL2D
            .Font.Bold = True
        End With
        sL2 = ""
    End If

    With shS.Cells(u + 4, 5).Resize(4)
        .Value = "м2"
        .Font.Bold = True
    End With
    With shS.Cells(u + 4, 6).Resize(3)
        .Value = Application.Transpose(Array("1-к кв.", "2-к кв.", "3-к кв."))
    End With
    
    If s1kD <> "" Then
        s1kD = Mid(s1kD, 2, Len(s1kD) - 1)
        s1kD = "=" & s1kD
        With shS.Cells(u + 4, 7).Resize(3, 2)
            .Formula = s1kD
        End With
        s1kD = ""
    End If
    
    Application.Calculation = Application_Calculation
End Sub
 

Mershik

Пользователь

Сообщений: 8277
Регистрация: 03.12.2015

voltron, кажется вам нужно дать МатросНаЗебре, «МАГАРЫЧ»

Не бойтесь совершенства. Вам его не достичь.

 

voltron

Пользователь

Сообщений: 8
Регистрация: 18.08.2021
 

voltron

Пользователь

Сообщений: 8
Регистрация: 18.08.2021

вот файл в котором не обрабатывается другие БС
 

Подтверждаю. Магарыч получил, ТС сам проявил инициативу.
 

МатросНаЗебре

Пользователь

Сообщений: 5516
Регистрация: 05.02.2014

#14

19.08.2021 11:07:56

Код 
Sub ЧетвёртыйЭтаж()
    Dim Application_Calculation As Long
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual

    Dim y1 As Long
    Dim y2 As Long
    Dim y3 As Long
    Dim u As Long
    Dim x As Long
    Dim k As Long
    Dim h As Long
    Dim j As Long
    Dim nKomInKv As Long
    Dim arrA As Variant
    Dim arDE As Variant
    Dim sFloor As String
    Dim sSection As String
    Dim v As Variant
    Dim s As String
    Dim sL1 As String
    Dim sL2 As String
    Dim sObSlp As String
    Dim sObBlp As String
    Dim sJil As String
    Dim sL2D As String
    Dim sObSlpD As String
    Dim sObBlpD As String
    Dim sJilD As String
    Dim s1kD As String
    
    Dim arrNkom As Variant
    ReDim arrNkom(1 To 3, 1 To 1)
    
    Dim arrSkom As Variant
    ReDim arrSkom(1 To 3, 1 To 1)
    
    Dim shD As Worksheet
    Set shD = Sheets("Диапазон")
    Dim shS As Worksheet
    Set shS = Sheets("Шахматка")
    shS.Select
    shS.Cells.Clear
    With shD
        y1 = .Cells(.Rows.Count, 1).End(xlUp).Row + 3
        arrA = .Range(.Cells(1, 1), .Cells(y1, "I"))
    End With
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim dicL As Object
    Set dicL = CreateObject("Scripting.Dictionary")
    
    u = 2
    j = 0
    
    For y1 = 3 To UBound(arrA, 1) - 2
        If arrA(y1, 1) <> "" Or (y1 >= UBound(arrA, 1) - 2) Then
        
        'If Left(arrA(y1, 2), Len("Квартира")) = "Квартира" Then
            If sFloor <> arrA(y1, 1) Then
                For k = 2 To x - 1 Step 2
                    shS.Cells(u + h + 1, k + 0).Value = "S жилая"
                    shS.Cells(u + h + 2, k + 0).Value = "S общая (без л.п.) "
                    shS.Cells(u + h + 3, k + 0).Value = "S общая"
                    shS.Cells(u + h + 2, k + 1).FormulaR1C1 = Application.ConvertFormula("=SUM(R" & u + 1 & "C:R" & u + h & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 2, k + 1))
                    sObBlp = sObBlp & "+" & Cells(u + h + 2, k + 1).Address(0, 0)
                    shS.Cells(u + h + 3, k + 1).FormulaR1C1 = Application.ConvertFormula("=SUM(R" & u + 1 & "C:R" & u + h & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 3, k + 1))
                    sObSlp = sObSlp & "+" & Cells(u + h + 3, k + 1).Address(0, 0)
                    j = j + 1
                    shS.Cells(u + h + 4, k + 1).Value = j
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).Merge
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).Font.Bold = True
                    shS.Cells(u + 0 + 0, k + 0).Resize(1, 2).Merge
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).HorizontalAlignment = xlCenter
                    shS.Cells(u + 0 + 0, k + 0).Resize(1, 2).HorizontalAlignment = xlCenter
                    shS.Cells(u + 0 + 0, k + 0).EntireColumn.ColumnWidth = 19.86
                    shS.Cells(u + 0 + 0, k + 1).EntireColumn.ColumnWidth = 10.14
                    
                    With shS.Cells(u + 0 + 0, k + 0).Resize(h + 5, 2)
                        For Each v In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
                            With .Borders(v)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlMedium
                            End With
                        Next
                        For Each v In Array(xlInsideVertical, xlInsideHorizontal)
                            With .Borders(v)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                        Next
                        With .Rows(1)
                            .Font.Bold = True
                            With .Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .ThemeColor = xlThemeColorAccent3
                                .TintAndShade = 0.799981688894314
                                .PatternTintAndShade = 0
                            End With
                        End With
                    End With
                    
                    With shS.Cells(u + h + 1, k + 0).Resize(3, 2).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 15204351
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    With shS.Cells(u + h + 3, k + 1).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 5296274
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    
                    nKomInKv = 0
                    s = ""
                    sL1 = ""
                    For y3 = u + 1 To u + h
                        If dic.Exists(Cells(y3, k + 1).Address(0, 0)) Then
                            s = s & "+R" & y3 & "C"
                            sJil = sJil & "+" & Cells(y3, k + 1).Address(0, 0)
                            nKomInKv = nKomInKv + 1
                        End If
                        If dicL.Exists(Cells(y3, k + 1).Address(0, 0)) Then
                            sL1 = sL1 & "+R" & y3 & "C"
                            sL2 = sL2 & "+" & Cells(y3, k + 1).Address(0, 0)
                        End If
                    Next
                    If s <> "" Then
                        s = Mid(s, 2, Len(s) - 1)
                        s = "=" & s
                        s = Application.ConvertFormula(s, xlR1C1, xlR1C1, xlRelative, Cells(u + h + 1, k + 1))
                        shS.Cells(u + h + 1, k + 1).FormulaR1C1 = s 'Application.ConvertFormula("=SUM(R" & u & "C:R" & u + h - 1 & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 1, k + 1))
                    End If
                    If sL1 <> "" Then
                        sL1 = Mid(sL1, 2, Len(sL1) - 1)
                        sL1 = Application.ConvertFormula(sL1, xlR1C1, xlR1C1, xlRelative, Cells(u + h + 2, k + 1))
                        With shS.Cells(u + h + 2, k + 1)
                            .FormulaR1C1 = .FormulaR1C1 & "-" & sL1
                        End With
                    End If
                    If nKomInKv > 0 And nKomInKv < 4 Then
                        arrNkom(nKomInKv, 1) = arrNkom(nKomInKv, 1) + 1
                        arrSkom(nKomInKv, 1) = arrSkom(nKomInKv, 1) + shS.Cells(u + h + 3, k + 1).Value
                        shS.Cells(u + 0 + 0, k + 0).Value = nKomInKv
                    End If
                    
                Next
                sFloor = arrA(y1, 1)
                
                If h > 1 Then
                    shS.Cells(u, 1).Resize(h + 5).Merge
                End If
                If h > 1 Then u = u + h + 5
                
                
                '--------------------------------
                If arrA(y1, 9) <> "" Or (y1 >= UBound(arrA, 1) - 2) Then
                    If sSection <> arrA(y1, 9) Then
                        If sSection <> "" Then
                            'u = u + 10
                            With shS.Cells(u + 2, 2).Resize(6)
                                .Value = Application.Transpose(Array("ИТОГО ПО СЕКЦИИ:", "", "1. S общая(с л.п.)", "2. S общая(б.л.п.)", "3. S жил.", "4. S летн."))
                                .Font.Bold = True
                            End With
                            If sObSlp <> "" Then
                                sObSlp = Mid(sObSlp, 2, Len(sObSlp) - 1)
                                sObSlp = "=" & sObSlp
                                With shS.Cells(u + 4, 4)
                                    .Formula = sObSlp
                                    .Font.Bold = True
                                    sObSlpD = sObSlpD & "+" & .Address(0, 0)
                                End With
                                sObSlp = ""
                            End If
                            If sObBlp <> "" Then
                                sObBlp = Mid(sObBlp, 2, Len(sObBlp) - 1)
                                sObBlp = "=" & sObBlp
                                With shS.Cells(u + 5, 4)
                                    .Formula = sObBlp
                                    .Font.Bold = True
                                    sObBlpD = sObBlpD & "+" & .Address(0, 0)
                                End With
                                sObBlp = ""
                            End If
                            If sJil <> "" Then
                                sJil = Mid(sJil, 2, Len(sJil) - 1)
                                sJil = "=" & sJil
                                With shS.Cells(u + 6, 4)
                                    .Formula = sJil
                                    .Font.Bold = True
                                    sJilD = sJilD & "+" & .Address(0, 0)
                                End With
                                sJil = ""
                            End If

                            If sL2 <> "" Then
                                sL2 = Mid(sL2, 2, Len(sL2) - 1)
                                sL2 = "=" & sL2
                                With shS.Cells(u + 7, 4)
                                    .Formula = sL2
                                    .Font.Bold = True
                                    sL2D = sL2D & "+" & .Address(0, 0)
                                End With
                                sL2 = ""
                            End If


                            With shS.Cells(u + 4, 5).Resize(4)
                                .Value = "м2"
                                .Font.Bold = True
                            End With
                            With shS.Cells(u + 4, 6).Resize(3)
                                .Value = Application.Transpose(Array("1-к кв.", "2-к кв.", "3-к кв."))
                            End With
                            With shS.Cells(u + 4, 7)
                                .Resize(UBound(arrNkom, 1)) = arrSkom
                                s1kD = s1kD & "+" & .Address(0, 0)
                            End With
                            With shS.Cells(u + 4, 8)
                                .Resize(UBound(arrNkom, 1)) = arrNkom
                                's1kD = s1kD & "+" & .Address(0, 0)
                            End With
                            ReDim arrNkom(1 To 3, 1 To 1)
                            ReDim arrSkom(1 To 3, 1 To 1)
                            u = u + 10
                        End If
                        sSection = arrA(y1, 9)
                            
                    End If
                End If
                '--------------------------------
'
                
                
'                u = u + h + 5
'                shS.Cells(u, 1).Value = arrA(y1, 1)
'                shS.Cells(u, 1).VerticalAlignment = xlCenter
                
                x = 2
                h = 1
            End If
            
            y2 = y1
            k = 0
            Do
                If y2 = UBound(arrA, 1) Then Exit Do
                If arrA(y2 + 1, 1) = "" Then Exit Do
                
                k = k + 1
                If arrA(y2 + 1, 7) > 0 Then
                    dic.Item(Cells(u + k + 1, x + 1).Address(0, 0)) = 0
                End If
                
                y2 = y2 + 1
            Loop
                            
                            
            y2 = y1
            k = 0
            Do
                If y2 = UBound(arrA, 1) Then Exit Do
                If arrA(y2 + 1, 1) = "" Then Exit Do
                
                k = k + 1
                Select Case arrA(y2 + 1, 4)
                Case "Терраса", "Лоджия", "Балкон", "Кухня -ниша", "Лоджия в теплом контуре"
                    dicL.Item(Cells(u + k + 1, x + 1).Address(0, 0)) = 0
                End Select
                
                y2 = y2 + 1
            Loop
                            
                            
                            
                            
            If Left(arrA(y1, 2), Len("Квартира")) = "Квартира" Then
                shS.Cells(u, 1).Value = arrA(y1, 1)
                shS.Cells(u, 1).VerticalAlignment = xlCenter
            
                arDE = shD.Cells(y1, "D").Resize(y2 - y1 + 1, 2)
                shS.Cells(u + 1, x).Resize(UBound(arDE, 1), UBound(arDE, 2)) = arDE
                If h < UBound(arDE, 1) Then h = UBound(arDE, 1)
                x = x + UBound(arDE, 2)
            End If
            
'            If arrA(y1 + 2, 9) <> "" Then
'                If sSection <> arrA(y1 + 2, 9) Then
'                    If sSection <> "" Then
'                        u = u + 10
'                    End If
'
'                    sSection = arrA(y1, 9)
'                End If
'            End If
            
            y1 = y2
        End If
    Next
    
    
    '------------------------------------------------------
    With shS.Cells(u + 2, 2).Resize(6)
        .Value = Application.Transpose(Array("ИТОГО ПО ДОМУ:", "", "1. S общая(с л.п.)", "2. S общая(б.л.п.)", "3. S жил.", "4. S летн."))
        .Font.Bold = True
    End With
    If sObSlpD <> "" Then
        sObSlpD = Mid(sObSlpD, 2, Len(sObSlpD) - 1)
        sObSlpD = "=" & sObSlpD
        With shS.Cells(u + 4, 4)
            .Formula = sObSlpD
            .Font.Bold = True
        End With
        sObSlp = ""
    End If
    If sObBlpD <> "" Then
        sObBlpD = Mid(sObBlpD, 2, Len(sObBlpD) - 1)
        sObBlpD = "=" & sObBlpD
        With shS.Cells(u + 5, 4)
            .Formula = sObBlpD
            .Font.Bold = True
        End With
        sObBlp = ""
    End If
    If sJilD <> "" Then
        sJilD = Mid(sJilD, 2, Len(sJilD) - 1)
        sJilD = "=" & sJilD
        With shS.Cells(u + 6, 4)
            .Formula = sJilD
            .Font.Bold = True
        End With
        sJil = ""
    End If

    If sL2D <> "" Then
        sL2D = Mid(sL2D, 2, Len(sL2D) - 1)
        sL2D = "=" & sL2D
        With shS.Cells(u + 7, 4)
            .Formula = sL2D
            .Font.Bold = True
        End With
        sL2 = ""
    End If

    With shS.Cells(u + 4, 5).Resize(4)
        .Value = "м2"
        .Font.Bold = True
    End With
    With shS.Cells(u + 4, 6).Resize(3)
        .Value = Application.Transpose(Array("1-к кв.", "2-к кв.", "3-к кв."))
    End With
    
    If s1kD <> "" Then
        s1kD = Mid(s1kD, 2, Len(s1kD) - 1)
        s1kD = "=" & s1kD
        With shS.Cells(u + 4, 7).Resize(3, 2)
            .Formula = s1kD
        End With
        s1kD = ""
    End If
    
    Application.Calculation = Application_Calculation
End Sub
 

voltron

Пользователь

Сообщений: 8
Регистрация: 18.08.2021

Кто такой ТС))
Все отлично уже нашел ошибку в шахматке выполнен6ной вручную)

МатросНаЗебре, Спасибо огромное!!!
Буду тестировать)
 

МатросНаЗебре

Пользователь

Сообщений: 5516
Регистрация: 05.02.2014

#16

19.08.2021 11:53:36

Код 
Option Explicit

Sub ПятыйЭтаж()
    Dim Application_Calculation As Long
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual

    Dim y1 As Long
    Dim y2 As Long
    Dim y3 As Long
    Dim u As Long
    Dim x As Long
    Dim k As Long
    Dim h As Long
    Dim j As Long
    Dim nKomInKv As Long
    Dim arrA As Variant
    Dim arDE As Variant
    Dim sFloor As String
    Dim sSection As String
    Dim v As Variant
    Dim s As String
    Dim sL1 As String
    Dim sL2 As String
    Dim sObSlp As String
    Dim sObBlp As String
    Dim sJil As String
    Dim sL2D As String
    Dim sObSlpD As String
    Dim sObBlpD As String
    Dim sJilD As String
    Dim s1kD As String
    
    Dim arrNkom As Variant
    ReDim arrNkom(1 To 3, 1 To 1)
    
    Dim arrSkom As Variant
    ReDim arrSkom(1 To 3, 1 To 1)
    
    Dim shD As Worksheet
    Set shD = Sheets("Диапазон")
    Dim shS As Worksheet
    Set shS = Sheets("Шахматка")
    shS.Select
    shS.Cells.Clear
    With shD
        y1 = .Cells(.Rows.Count, 1).End(xlUp).Row + 3
        arrA = .Range(.Cells(1, 1), .Cells(y1, "I"))
    End With
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim dicL As Object
    Set dicL = CreateObject("Scripting.Dictionary")
    
    u = 5
    j = 0
    
    For y1 = 3 To UBound(arrA, 1) - 2
        If arrA(y1, 1) <> "" Or (y1 >= UBound(arrA, 1) - 2) Then
        
        'If Left(arrA(y1, 2), Len("Квартира")) = "Квартира" Then
            If sFloor <> arrA(y1, 1) Then
                For k = 2 To x - 1 Step 2
                    shS.Cells(u + h + 1, k + 0).Value = "S жилая"
                    shS.Cells(u + h + 2, k + 0).Value = "S общая (без л.п.) "
                    shS.Cells(u + h + 3, k + 0).Value = "S общая"
                    shS.Cells(u + h + 2, k + 1).FormulaR1C1 = Application.ConvertFormula("=SUM(R" & u + 1 & "C:R" & u + h & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 2, k + 1))
                    sObBlp = sObBlp & "+" & Cells(u + h + 2, k + 1).Address(0, 0)
                    shS.Cells(u + h + 3, k + 1).FormulaR1C1 = Application.ConvertFormula("=SUM(R" & u + 1 & "C:R" & u + h & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 3, k + 1))
                    sObSlp = sObSlp & "+" & Cells(u + h + 3, k + 1).Address(0, 0)
                    j = j + 1
                    shS.Cells(u + h + 4, k + 1).Value = j
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).Merge
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).Font.Bold = True
                    shS.Cells(u + 0 + 0, k + 0).Resize(1, 2).Merge
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).HorizontalAlignment = xlCenter
                    shS.Cells(u + 0 + 0, k + 0).Resize(1, 2).HorizontalAlignment = xlCenter
                    shS.Cells(u + 0 + 0, k + 0).EntireColumn.ColumnWidth = 19.86
                    shS.Cells(u + 0 + 0, k + 1).EntireColumn.ColumnWidth = 10.14
                    
                    With shS.Cells(u + 0 + 0, k + 0).Resize(h + 5, 2)
                        For Each v In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
                            With .Borders(v)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlMedium
                            End With
                        Next
                        For Each v In Array(xlInsideVertical, xlInsideHorizontal)
                            With .Borders(v)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                        Next
                        With .Rows(1)
                            .Font.Bold = True
                            With .Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .ThemeColor = xlThemeColorAccent3
                                .TintAndShade = 0.799981688894314
                                .PatternTintAndShade = 0
                            End With
                        End With
                    End With
                    
                    With shS.Cells(u + h + 1, k + 0).Resize(3, 2).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 15204351
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    With shS.Cells(u + h + 3, k + 1).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 5296274
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    
                    nKomInKv = 0
                    s = ""
                    sL1 = ""
                    For y3 = u + 1 To u + h
                        If dic.Exists(Cells(y3, k + 1).Address(0, 0)) Then
                            s = s & "+R" & y3 & "C"
                            sJil = sJil & "+" & Cells(y3, k + 1).Address(0, 0)
                            nKomInKv = nKomInKv + 1
                        End If
                        If dicL.Exists(Cells(y3, k + 1).Address(0, 0)) Then
                            sL1 = sL1 & "+R" & y3 & "C"
                            sL2 = sL2 & "+" & Cells(y3, k + 1).Address(0, 0)
                        End If
                    Next
                    If s <> "" Then
                        s = Mid(s, 2, Len(s) - 1)
                        s = "=" & s
                        s = Application.ConvertFormula(s, xlR1C1, xlR1C1, xlRelative, Cells(u + h + 1, k + 1))
                        shS.Cells(u + h + 1, k + 1).FormulaR1C1 = s 'Application.ConvertFormula("=SUM(R" & u & "C:R" & u + h - 1 & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 1, k + 1))
                    End If
                    If sL1 <> "" Then
                        sL1 = Mid(sL1, 2, Len(sL1) - 1)
                        sL1 = Application.ConvertFormula(sL1, xlR1C1, xlR1C1, xlRelative, Cells(u + h + 2, k + 1))
                        With shS.Cells(u + h + 2, k + 1)
                            .FormulaR1C1 = .FormulaR1C1 & "-" & sL1
                        End With
                    End If
                    If nKomInKv > 0 And nKomInKv < 4 Then
                        arrNkom(nKomInKv, 1) = arrNkom(nKomInKv, 1) + 1
                        arrSkom(nKomInKv, 1) = arrSkom(nKomInKv, 1) + shS.Cells(u + h + 3, k + 1).Value
                        shS.Cells(u + 0 + 0, k + 0).Value = nKomInKv & IIf(nKomInKv = 1, "", "-х") & " ком."
                    End If
                    
                Next
                sFloor = arrA(y1, 1)
                
                If h > 1 Then
                    shS.Cells(u, 1).Resize(h + 5).Merge
                End If
                If h > 1 Then u = u + h + 5
                
                
                '--------------------------------
                If arrA(y1, 9) <> "" Or (y1 >= UBound(arrA, 1) - 2) Then
                    If sSection <> arrA(y1, 9) Then
                        If sSection <> "" Then
                            'u = u + 10
                            With shS.Cells(u + 2, 2).Resize(6)
                                .Value = Application.Transpose(Array("ИТОГО ПО СЕКЦИИ:", "", "1. S общая(с л.п.)", "2. S общая(б.л.п.)", "3. S жил.", "4. S летн."))
                                .Font.Bold = True
                            End With
                            If sObSlp <> "" Then
                                sObSlp = Mid(sObSlp, 2, Len(sObSlp) - 1)
                                sObSlp = "=" & sObSlp
                                With shS.Cells(u + 4, 4)
                                    .Formula = sObSlp
                                    .Font.Bold = True
                                    sObSlpD = sObSlpD & "+" & .Address(0, 0)
                                End With
                                sObSlp = ""
                            End If
                            If sObBlp <> "" Then
                                sObBlp = Mid(sObBlp, 2, Len(sObBlp) - 1)
                                sObBlp = "=" & sObBlp
                                With shS.Cells(u + 5, 4)
                                    .Formula = sObBlp
                                    .Font.Bold = True
                                    sObBlpD = sObBlpD & "+" & .Address(0, 0)
                                End With
                                sObBlp = ""
                            End If
                            If sJil <> "" Then
                                sJil = Mid(sJil, 2, Len(sJil) - 1)
                                sJil = "=" & sJil
                                With shS.Cells(u + 6, 4)
                                    .Formula = sJil
                                    .Font.Bold = True
                                    sJilD = sJilD & "+" & .Address(0, 0)
                                End With
                                sJil = ""
                            End If

                            If sL2 <> "" Then
                                sL2 = Mid(sL2, 2, Len(sL2) - 1)
                                sL2 = "=" & sL2
                                With shS.Cells(u + 7, 4)
                                    .Formula = sL2
                                    .Font.Bold = True
                                    sL2D = sL2D & "+" & .Address(0, 0)
                                End With
                                sL2 = ""
                            End If


                            With shS.Cells(u + 4, 5).Resize(4)
                                .Value = "м2"
                                .Font.Bold = True
                            End With
                            With shS.Cells(u + 4, 6).Resize(3)
                                .Value = Application.Transpose(Array("1-к кв.", "2-к кв.", "3-к кв."))
                            End With
                            With shS.Cells(u + 4, 7)
                                .Resize(UBound(arrNkom, 1)) = arrSkom
                                s1kD = s1kD & "+" & .Address(0, 0)
                            End With
                            With shS.Cells(u + 4, 8)
                                .Resize(UBound(arrNkom, 1)) = arrNkom
                                's1kD = s1kD & "+" & .Address(0, 0)
                            End With
                            ReDim arrNkom(1 To 3, 1 To 1)
                            ReDim arrSkom(1 To 3, 1 To 1)
                            
                            u = u + 11
                        End If
                        sSection = arrA(y1, 9)
                            
                        With shS.Rows(u - 2)
                            .Cells(1, 2).Value = sSection
                            .Font.Bold = True
                            With .Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .ThemeColor = xlThemeColorAccent3
                                .TintAndShade = 0.799981688894314
                                .PatternTintAndShade = 0
                            End With
                        End With
                            
                    End If
                End If
                '--------------------------------
'
                
                
'                u = u + h + 5
'                shS.Cells(u, 1).Value = arrA(y1, 1)
'                shS.Cells(u, 1).VerticalAlignment = xlCenter
                
                x = 2
                h = 1
            End If
            
            y2 = y1
            k = 0
            Do
                If y2 = UBound(arrA, 1) Then Exit Do
                If arrA(y2 + 1, 1) = "" Then Exit Do
                
                k = k + 1
                If arrA(y2 + 1, 7) > 0 Then
                    dic.Item(Cells(u + k + 1, x + 1).Address(0, 0)) = 0
                End If
                
                y2 = y2 + 1
            Loop
                            
                            
            y2 = y1
            k = 0
            Do
                If y2 = UBound(arrA, 1) Then Exit Do
                If arrA(y2 + 1, 1) = "" Then Exit Do
                
                k = k + 1
                Select Case arrA(y2 + 1, 4)
                Case "Терраса", "Лоджия", "Балкон", "Кухня -ниша", "Лоджия в теплом контуре"
                    dicL.Item(Cells(u + k + 1, x + 1).Address(0, 0)) = 0
                End Select
                
                y2 = y2 + 1
            Loop
                            
                            
                            
                            
            If Left(arrA(y1, 2), Len("Квартира")) = "Квартира" Then
                shS.Cells(u, 1).Value = arrA(y1, 1)
                shS.Cells(u, 1).VerticalAlignment = xlCenter
            
                arDE = shD.Cells(y1, "D").Resize(y2 - y1 + 1, 2)
                shS.Cells(u + 1, x).Resize(UBound(arDE, 1), UBound(arDE, 2)) = arDE
                If h < UBound(arDE, 1) Then h = UBound(arDE, 1)
                x = x + UBound(arDE, 2)
            End If
            
'            If arrA(y1 + 2, 9) <> "" Then
'                If sSection <> arrA(y1 + 2, 9) Then
'                    If sSection <> "" Then
'                        u = u + 10
'                    End If
'
'                    sSection = arrA(y1, 9)
'                End If
'            End If
            
            y1 = y2
        End If
    Next
    
    
    '------------------------------------------------------
    With shS.Cells(u + 2, 2).Resize(6)
        .Value = Application.Transpose(Array("ИТОГО ПО ДОМУ:", "", "1. S общая(с л.п.)", "2. S общая(б.л.п.)", "3. S жил.", "4. S летн."))
        .Font.Bold = True
    End With
    If sObSlpD <> "" Then
        sObSlpD = Mid(sObSlpD, 2, Len(sObSlpD) - 1)
        sObSlpD = "=" & sObSlpD
        With shS.Cells(u + 4, 4)
            .Formula = sObSlpD
            .Font.Bold = True
        End With
        sObSlp = ""
    End If
    If sObBlpD <> "" Then
        sObBlpD = Mid(sObBlpD, 2, Len(sObBlpD) - 1)
        sObBlpD = "=" & sObBlpD
        With shS.Cells(u + 5, 4)
            .Formula = sObBlpD
            .Font.Bold = True
        End With
        sObBlp = ""
    End If
    If sJilD <> "" Then
        sJilD = Mid(sJilD, 2, Len(sJilD) - 1)
        sJilD = "=" & sJilD
        With shS.Cells(u + 6, 4)
            .Formula = sJilD
            .Font.Bold = True
        End With
        sJil = ""
    End If

    If sL2D <> "" Then
        sL2D = Mid(sL2D, 2, Len(sL2D) - 1)
        sL2D = "=" & sL2D
        With shS.Cells(u + 7, 4)
            .Formula = sL2D
            .Font.Bold = True
        End With
        sL2 = ""
    End If

    With shS.Cells(u + 4, 5).Resize(4)
        .Value = "м2"
        .Font.Bold = True
    End With
    With shS.Cells(u + 4, 6).Resize(3)
        .Value = Application.Transpose(Array("1-к кв.", "2-к кв.", "3-к кв."))
    End With
    
    If s1kD <> "" Then
        s1kD = Mid(s1kD, 2, Len(s1kD) - 1)
        s1kD = "=" & s1kD
        With shS.Cells(u + 4, 7).Resize(3, 2)
            .Formula = s1kD
        End With
        s1kD = ""
    End If
    
    Application.Calculation = Application_Calculation
End Sub

Изменено: МатросНаЗебре — 19.08.2021 11:58:25
 

МатросНаЗебре

Пользователь

Сообщений: 5516
Регистрация: 05.02.2014

#17

19.08.2021 12:08:16

Добавил обработку на случай, если в секции один этаж.

Код 
Option Explicit

Sub ШестойЭтаж()
    Dim Application_Calculation As Long
    Application_Calculation = Application.Calculation
    Application.Calculation = xlCalculationManual

    Dim y1 As Long
    Dim y2 As Long
    Dim y3 As Long
    Dim u As Long
    Dim x As Long
    Dim k As Long
    Dim h As Long
    Dim j As Long
    Dim nKomInKv As Long
    Dim arrA As Variant
    Dim arDE As Variant
    Dim sFloor As String
    Dim sSection As String
    Dim v As Variant
    Dim s As String
    Dim sL1 As String
    Dim sL2 As String
    Dim sObSlp As String
    Dim sObBlp As String
    Dim sJil As String
    Dim sL2D As String
    Dim sObSlpD As String
    Dim sObBlpD As String
    Dim sJilD As String
    Dim s1kD As String
    
    Dim arrNkom As Variant
    ReDim arrNkom(1 To 3, 1 To 1)
    
    Dim arrSkom As Variant
    ReDim arrSkom(1 To 3, 1 To 1)
    
    Dim shD As Worksheet
    Set shD = Sheets("Диапазон")
    Dim shS As Worksheet
    Set shS = Sheets("Шахматка")
    shS.Select
    shS.Cells.Clear
    With shD
        y1 = .Cells(.Rows.Count, 1).End(xlUp).Row + 3
        arrA = .Range(.Cells(1, 1), .Cells(y1, "I"))
    End With
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim dicL As Object
    Set dicL = CreateObject("Scripting.Dictionary")
    
    u = 5
    j = 0
    
    For y1 = 3 To UBound(arrA, 1) - 2
        If arrA(y1, 1) <> "" Or (y1 >= UBound(arrA, 1) - 2) Then
        
        'If Left(arrA(y1, 2), Len("Квартира")) = "Квартира" Then
            If sFloor <> arrA(y1, 1) Or (sSection <> arrA(y1, 9)) Then
                For k = 2 To x - 1 Step 2
                    shS.Cells(u + h + 1, k + 0).Value = "S жилая"
                    shS.Cells(u + h + 2, k + 0).Value = "S общая (без л.п.) "
                    shS.Cells(u + h + 3, k + 0).Value = "S общая"
                    shS.Cells(u + h + 2, k + 1).FormulaR1C1 = Application.ConvertFormula("=SUM(R" & u + 1 & "C:R" & u + h & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 2, k + 1))
                    sObBlp = sObBlp & "+" & Cells(u + h + 2, k + 1).Address(0, 0)
                    shS.Cells(u + h + 3, k + 1).FormulaR1C1 = Application.ConvertFormula("=SUM(R" & u + 1 & "C:R" & u + h & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 3, k + 1))
                    sObSlp = sObSlp & "+" & Cells(u + h + 3, k + 1).Address(0, 0)
                    j = j + 1
                    shS.Cells(u + h + 4, k + 1).Value = j
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).Merge
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).Font.Bold = True
                    shS.Cells(u + 0 + 0, k + 0).Resize(1, 2).Merge
                    shS.Cells(u + h + 4, k + 0).Resize(1, 2).HorizontalAlignment = xlCenter
                    shS.Cells(u + 0 + 0, k + 0).Resize(1, 2).HorizontalAlignment = xlCenter
                    shS.Cells(u + 0 + 0, k + 0).EntireColumn.ColumnWidth = 19.86
                    shS.Cells(u + 0 + 0, k + 1).EntireColumn.ColumnWidth = 10.14
                    
                    With shS.Cells(u + 0 + 0, k + 0).Resize(h + 5, 2)
                        For Each v In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
                            With .Borders(v)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlMedium
                            End With
                        Next
                        For Each v In Array(xlInsideVertical, xlInsideHorizontal)
                            With .Borders(v)
                                .LineStyle = xlContinuous
                                .ColorIndex = 0
                                .TintAndShade = 0
                                .Weight = xlThin
                            End With
                        Next
                        With .Rows(1)
                            .Font.Bold = True
                            With .Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .ThemeColor = xlThemeColorAccent3
                                .TintAndShade = 0.799981688894314
                                .PatternTintAndShade = 0
                            End With
                        End With
                    End With
                    
                    With shS.Cells(u + h + 1, k + 0).Resize(3, 2).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 15204351
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    With shS.Cells(u + h + 3, k + 1).Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 5296274
                        .TintAndShade = 0
                        .PatternTintAndShade = 0
                    End With
                    
                    nKomInKv = 0
                    s = ""
                    sL1 = ""
                    For y3 = u + 1 To u + h
                        If dic.Exists(Cells(y3, k + 1).Address(0, 0)) Then
                            s = s & "+R" & y3 & "C"
                            sJil = sJil & "+" & Cells(y3, k + 1).Address(0, 0)
                            nKomInKv = nKomInKv + 1
                        End If
                        If dicL.Exists(Cells(y3, k + 1).Address(0, 0)) Then
                            sL1 = sL1 & "+R" & y3 & "C"
                            sL2 = sL2 & "+" & Cells(y3, k + 1).Address(0, 0)
                        End If
                    Next
                    If s <> "" Then
                        s = Mid(s, 2, Len(s) - 1)
                        s = "=" & s
                        s = Application.ConvertFormula(s, xlR1C1, xlR1C1, xlRelative, Cells(u + h + 1, k + 1))
                        shS.Cells(u + h + 1, k + 1).FormulaR1C1 = s 'Application.ConvertFormula("=SUM(R" & u & "C:R" & u + h - 1 & "C)", xlR1C1, xlR1C1, xlRelative, Cells(u + h + 1, k + 1))
                    End If
                    If sL1 <> "" Then
                        sL1 = Mid(sL1, 2, Len(sL1) - 1)
                        sL1 = Application.ConvertFormula(sL1, xlR1C1, xlR1C1, xlRelative, Cells(u + h + 2, k + 1))
                        With shS.Cells(u + h + 2, k + 1)
                            .FormulaR1C1 = .FormulaR1C1 & "-" & sL1
                        End With
                    End If
                    If nKomInKv > 0 And nKomInKv < 4 Then
                        arrNkom(nKomInKv, 1) = arrNkom(nKomInKv, 1) + 1
                        arrSkom(nKomInKv, 1) = arrSkom(nKomInKv, 1) + shS.Cells(u + h + 3, k + 1).Value
                        shS.Cells(u + 0 + 0, k + 0).Value = nKomInKv & IIf(nKomInKv = 1, "", "-х") & " ком."
                    End If
                    
                Next
                sFloor = arrA(y1, 1)
                
                If h > 1 Then
                    shS.Cells(u, 1).Resize(h + 5).Merge
                End If
                If h > 1 Then u = u + h + 5
                
                
                '--------------------------------
                If arrA(y1, 9) <> "" Or (y1 >= UBound(arrA, 1) - 2) Then
                    If sSection <> arrA(y1, 9) Then
                        If sSection <> "" Then
                            'u = u + 10
                            With shS.Cells(u + 2, 2).Resize(6)
                                .Value = Application.Transpose(Array("ИТОГО ПО СЕКЦИИ:", "", "1. S общая(с л.п.)", "2. S общая(б.л.п.)", "3. S жил.", "4. S летн."))
                                .Font.Bold = True
                            End With
                            If sObSlp <> "" Then
                                sObSlp = Mid(sObSlp, 2, Len(sObSlp) - 1)
                                sObSlp = "=" & sObSlp
                                With shS.Cells(u + 4, 4)
                                    .Formula = sObSlp
                                    .Font.Bold = True
                                    sObSlpD = sObSlpD & "+" & .Address(0, 0)
                                End With
                                sObSlp = ""
                            End If
                            If sObBlp <> "" Then
                                sObBlp = Mid(sObBlp, 2, Len(sObBlp) - 1)
                                sObBlp = "=" & sObBlp
                                With shS.Cells(u + 5, 4)
                                    .Formula = sObBlp
                                    .Font.Bold = True
                                    sObBlpD = sObBlpD & "+" & .Address(0, 0)
                                End With
                                sObBlp = ""
                            End If
                            If sJil <> "" Then
                                sJil = Mid(sJil, 2, Len(sJil) - 1)
                                sJil = "=" & sJil
                                With shS.Cells(u + 6, 4)
                                    .Formula = sJil
                                    .Font.Bold = True
                                    sJilD = sJilD & "+" & .Address(0, 0)
                                End With
                                sJil = ""
                            End If

                            If sL2 <> "" Then
                                sL2 = Mid(sL2, 2, Len(sL2) - 1)
                                sL2 = "=" & sL2
                                With shS.Cells(u + 7, 4)
                                    .Formula = sL2
                                    .Font.Bold = True
                                    sL2D = sL2D & "+" & .Address(0, 0)
                                End With
                                sL2 = ""
                            End If


                            With shS.Cells(u + 4, 5).Resize(4)
                                .Value = "м2"
                                .Font.Bold = True
                            End With
                            With shS.Cells(u + 4, 6).Resize(3)
                                .Value = Application.Transpose(Array("1-к кв.", "2-к кв.", "3-к кв."))
                            End With
                            With shS.Cells(u + 4, 7)
                                .Resize(UBound(arrNkom, 1)) = arrSkom
                                s1kD = s1kD & "+" & .Address(0, 0)
                            End With
                            With shS.Cells(u + 4, 8)
                                .Resize(UBound(arrNkom, 1)) = arrNkom
                                's1kD = s1kD & "+" & .Address(0, 0)
                            End With
                            ReDim arrNkom(1 To 3, 1 To 1)
                            ReDim arrSkom(1 To 3, 1 To 1)
                            
                            u = u + 11
                        End If
                        sSection = arrA(y1, 9)
                            
                        With shS.Rows(u - 2)
                            .Cells(1, 2).Value = sSection
                            .Font.Bold = True
                            With .Interior
                                .Pattern = xlSolid
                                .PatternColorIndex = xlAutomatic
                                .ThemeColor = xlThemeColorAccent3
                                .TintAndShade = 0.799981688894314
                                .PatternTintAndShade = 0
                            End With
                        End With
                            
                    End If
                End If
                '--------------------------------
'
                
                
'                u = u + h + 5
'                shS.Cells(u, 1).Value = arrA(y1, 1)
'                shS.Cells(u, 1).VerticalAlignment = xlCenter
                
                x = 2
                h = 1
            End If
            
            y2 = y1
            k = 0
            Do
                If y2 = UBound(arrA, 1) Then Exit Do
                If arrA(y2 + 1, 1) = "" Then Exit Do
                
                k = k + 1
                If arrA(y2 + 1, 7) > 0 Then
                    dic.Item(Cells(u + k + 1, x + 1).Address(0, 0)) = 0
                End If
                
                y2 = y2 + 1
            Loop
                            
                            
            y2 = y1
            k = 0
            Do
                If y2 = UBound(arrA, 1) Then Exit Do
                If arrA(y2 + 1, 1) = "" Then Exit Do
                
                k = k + 1
                Select Case arrA(y2 + 1, 4)
                Case "Терраса", "Лоджия", "Балкон", "Кухня -ниша", "Лоджия в теплом контуре"
                    dicL.Item(Cells(u + k + 1, x + 1).Address(0, 0)) = 0
                End Select
                
                y2 = y2 + 1
            Loop
                            
                            
                            
                            
            If Left(arrA(y1, 2), Len("Квартира")) = "Квартира" Then
                shS.Cells(u, 1).Value = arrA(y1, 1)
                shS.Cells(u, 1).VerticalAlignment = xlCenter
            
                arDE = shD.Cells(y1, "D").Resize(y2 - y1 + 1, 2)
                shS.Cells(u + 1, x).Resize(UBound(arDE, 1), UBound(arDE, 2)) = arDE
                If h < UBound(arDE, 1) Then h = UBound(arDE, 1)
                x = x + UBound(arDE, 2)
            End If
            
'            If arrA(y1 + 2, 9) <> "" Then
'                If sSection <> arrA(y1 + 2, 9) Then
'                    If sSection <> "" Then
'                        u = u + 10
'                    End If
'
'                    sSection = arrA(y1, 9)
'                End If
'            End If
            
            y1 = y2
        End If
    Next
    
    
    '------------------------------------------------------
    With shS.Cells(u + 2, 2).Resize(6)
        .Value = Application.Transpose(Array("ИТОГО ПО ДОМУ:", "", "1. S общая(с л.п.)", "2. S общая(б.л.п.)", "3. S жил.", "4. S летн."))
        .Font.Bold = True
    End With
    If sObSlpD <> "" Then
        sObSlpD = Mid(sObSlpD, 2, Len(sObSlpD) - 1)
        sObSlpD = "=" & sObSlpD
        With shS.Cells(u + 4, 4)
            .Formula = sObSlpD
            .Font.Bold = True
        End With
        sObSlp = ""
    End If
    If sObBlpD <> "" Then
        sObBlpD = Mid(sObBlpD, 2, Len(sObBlpD) - 1)
        sObBlpD = "=" & sObBlpD
        With shS.Cells(u + 5, 4)
            .Formula = sObBlpD
            .Font.Bold = True
        End With
        sObBlp = ""
    End If
    If sJilD <> "" Then
        sJilD = Mid(sJilD, 2, Len(sJilD) - 1)
        sJilD = "=" & sJilD
        With shS.Cells(u + 6, 4)
            .Formula = sJilD
            .Font.Bold = True
        End With
        sJil = ""
    End If

    If sL2D <> "" Then
        sL2D = Mid(sL2D, 2, Len(sL2D) - 1)
        sL2D = "=" & sL2D
        With shS.Cells(u + 7, 4)
            .Formula = sL2D
            .Font.Bold = True
        End With
        sL2 = ""
    End If

    With shS.Cells(u + 4, 5).Resize(4)
        .Value = "м2"
        .Font.Bold = True
    End With
    With shS.Cells(u + 4, 6).Resize(3)
        .Value = Application.Transpose(Array("1-к кв.", "2-к кв.", "3-к кв."))
    End With
    
    If s1kD <> "" Then
        s1kD = Mid(s1kD, 2, Len(s1kD) - 1)
        s1kD = "=" & s1kD
        With shS.Cells(u + 4, 7).Resize(3, 2)
            .Formula = s1kD
        End With
        s1kD = ""
    End If
    
    Application.Calculation = Application_Calculation
End Sub
 

voltron

Пользователь

Сообщений: 8
Регистрация: 18.08.2021

#18

19.08.2021 12:17:15

Огонь! все супер!  8)
еще раз спасибо большое!
Источник

Оглавление:

  • 1 Как сделать шахматку в excel? — Разбираем подробно
  • 2 Кто обязан составлять шахматную ведомость
  • 3 Зачем нужна шахматная ведомость
  • 4 Правила оформления ведомости
  • 5 Пример составления ведомости
  • 6 После составления шахматной ведомости
  • 7 Форма шахматной оборотной ведомости
  • 8 Возможности шахматной ведомости
  • 9 Принцип составления документа на предприятии
  • 10 Проверка показателей при заполнении
  • 11 Ведомость для малых предприятий
  • 12 Отличие шахматной от оборотной ведомости
  • 13 Источники формирования данных
  • 14 Частые вопросы про шахматную ведомость
    • 14.1 Это может быть интересно:
  • 15 Как создать таблицу в Excel для чайников
    • 15.1 Как выделить столбец и строку
    • 15.2 Как изменить границы ячеек
    • 15.3 Как вставить столбец или строку
    • 15.4 Пошаговое создание таблицы с формулами
  • 16 Как создать таблицу в Excel: пошаговая инструкция
  • 17 Как работать с таблицей в Excel

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

ФАЙЛЫ
Скачать пустой бланк шахматной ведомости .xlsСкачать образец заполнения шахматной ведомости .xls

Кто обязан составлять шахматную ведомость

Заполнение шахматной ведомости является обязанностью бухгалтеров многих коммерческих структур, но при этом далеко не всех. Исключение составляют те, кто:

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

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

    Зачем нужна шахматная ведомость

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

    Правила оформления ведомости

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

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

    Сведения в документ вносятся на основании журнала операций, в котором регистрируются все бухгалтерские проводки.

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

    Пример составления ведомости

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

    1. Вначале документа заполняется «шапка»: вписывается полное наименование предприятия, а также период, за который составляется документ.
    2. Далее, необходимо обратить внимание на способ внесения сведений в таблицу ведомости. Формирование данных происходит в двух направлениях:
    3. обороты по кредиту вносятся в горизонтальные строки,
    4. по дебету – в вертикальные столбцы.

      5. Сумма, которая проводится по обоим этим счетам и ставится на пересечении соответствующей строки и столбика.

    5. В последней строке документа «Итог», в самом низу таблицы, подсчитываются все внесенные в каждый столбик суммы и указывается итоговый результат по каждому столбику в отдельности по кредитовым счетам. Аналогичным образом подсчитывается во всех строках и вписывается результат по дебетовым счетам, но только уже данные заносятся в последний вертикальный столбик.

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

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

    Как сделать шахматку в excel?

    После составления шахматной ведомости

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

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

    Форма шахматной оборотной ведомости

    Шахматная ведомость содержит итоговые данные корреспонденции счетов по однородным операциям. Ведомость составляется в табличной форме. Запись одного числового показатели свидетельствует одновременно о проводке по дебету и кредиту счета. Читайте также статью: → «Бухгалтерские оборотные ведомости».

    Пример фрагмента шахматной ведомости приведен в таблице:

    Кредит   Дебет 2:00 200 200 100 300 300 300 350 350 200 200 350 350 100 100 300 300 200 300 300 300 200 350 100 350 2100

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

    Возможности шахматной ведомости

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

    Простота записи данных в документе позволяет одномоментно выявить неверный показатель, разноску по счетам с арифметическими ошибками. Наглядность учетных данных – основное достоинство формы. Одновременно шахматная ведомость не позволяет выявить ошибки в случаях:

  • отсутствия двойной записи по счетам;
  • записи неправильной проводки по счетам с одинаковыми суммами;
  • записи верной корреспонденции с неверными суммами.

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

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

    При отсутствии количественной оценки (например, для счетов расчетов) ведомость, составленная с детализацией, формируется в денежном выражении.

    Принцип составления документа на предприятии

    Форма имеет строгую разбивку по дебету (вертикаль) и кредиту (горизонталь) счетов. В клетке пересечения производится запись суммового показателя. Данные ведомости можно расширить – использовать одновременно с учетом сальдо на начало периода и выводом остатка. Документ называется шахматным балансом и является аналогом главной книги. Порядок заполнения формы:

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

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

    Проверка показателей при заполнении

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

    Верно проведенная разноска исключает ошибки, что подтверждается одинаковыми итогами по вертикали и горизонтали ведомости. При формировании ведомости бухгалтер может сразу увидеть возникновение нестандартных проводок. Ряд счетов не могут иметь корреспонденций между собой. Читайте также статью: → «Форма Т-53. Платежная ведомость: образец заполнения».

    При нестыковке итоговых данных необходимо проверить составляющие учета:

  • Соответствие показателей данных первичного учета разнесенным показателям.
  • Верность определения счета.
  • Наличие прикрепленной стандартной проводки к записи в журнале операций.
  • Верность проводки при использовании самостоятельно установленной двойной записи.

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

    Ведомость для малых предприятий

    В обороте малых предприятий, отличающихся ограниченным количеством счетов учета и незначительным числом операций, используется шахматная ведомость образца № В-9. Составление документа производится ежемесячно, с открытием документа на начало месяца. Особенность бланка состоит в расположении по вертикали счетов учета, по горизонтали – ведомостей. Нумерация и данные располагаются в порядке возрастания.

    По истечении месяца производится подсчет дебетовых оборотов по счетам и кредитовые ведомостям.

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

    Отличие шахматной от оборотной ведомости

    При систематизации и обобщении учетных данных, кроме шахматной формы, используют оборотную ведомость. Читайте также статью: → «Форма Т-49. Расчетно-платежная ведомость». Особенности группировки данных:

  • Заполнение производится по оборотам и остаткам счетов синтетического учета.
  • Основой составления формы является итоговая запись по счетам.
  • При проверке используется принцип равенства трех пар данных – начальных, конечных остатков, оборотов по кредиту и дебету всех счетов.

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

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

    Источники формирования данных

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

    Предприятие при ведении учета оформило операции:

    1. Приняты на учет комплектующие, поступившие от поставщика: Дт 10 Кт 60 – 20 000 рублей;
    2. Произведена оплата за поставку комплектующих: Дт 60 Кт 51 – 20 000 рублей;
    3. Комплектующие переданы в производство: Дт 20 Кт 10 – 20 000 рублей;
    4. Начислена заработная плата рабочим: Дт 20 Кт 70 – 25 000 рублей;
    5. Выплачена заработная плата на карту: Дт 70 Кт 51 – 25 000 рублей. Вывод: итоговая сумма по кредиту и дебету совпала, операции проведены верно.

    Кредит Итог Дебет 20 000 20 000 20 000 25 000 45 000 20 000 20 000 25 000 25 000 Итог 20 000 45 000 20 000 25 000 110 000

    Частые вопросы про шахматную ведомость

    Вопрос №1. Используются ли при составлении «шахматки» данные, учтенные за балансом?

    Как сделать шахматку в excel?

    Как сделать шахматку в excel?

    Как сделать шахматку в excel?

    При составлении формы данные по забалансовым счетам не используются.

    Вопрос №2. Имеется ли необходимости выведения документа на печать и хранение с документами бухгалтерского учета?

    Шахматная ведомость используется для контроля верности разноски и не является обязательным документом бухгалтерского учета. Порядок хранения определяют учетные работники.

    Вопрос №3. Возможно ли сократить объемность шахматной ведомости?

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

    Вопрос №4. Можно ли использовать данные шахматной ведомости для анализа показателей деятельности?

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

    Оцените качество статьи. Мы хотим стать лучше для вас:

    Если вы не нашли ответ на свой вопрос, то вы можете получить ответ на свой вопрос позвонив по номерам ⇓

    Юридическая Консультация бесплатная Москва, Московская область звоните: +7 (499) 288-17-58

    Звонок в один клик

    Санкт-Петербург, Ленинградская область звоните: +7 (812) 317-60-16

    Звонок в один клик

    Из других регионов РФ звоните: 8 (800) 550-34-98

    Звонок в один клик

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

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

    На пересечении определённого столба и строки ставится сумма, участвующая в проводке с этими счетами.
    Внизу в последней строке проставляется сумма каждого столбца, суммы кредитуемых счетов. Эта строка имеет название «Итог». Также таблица имеет итоговый столбец, в котором отражаются суммы каждой строки, итоги дебетовых оборотов.
    Количество строк и столбцов индивидуально и зависит от того, сколько в конкретной организации используется бух. счетов.
    Очень легко проверятся правильность составления шахматной ведомости, итоговая строка ВСЕГДА должна равняться сумме итогового последнего столбца.

    Посмотрим на примере?
    За январь произведены следующие хозяйственные операции.

    Как составить шахматную ведомость?

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

    Начнем по плану.

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

    Дом. Задание.
    Составить шахматную ведомость по следующим данным. За январь в ООО «ЛУЧ» произошли следующие хоз. операции.

    1. Поступили товары от поставщика на сумму 32 000 руб.
    2. Начислена зарплата работникам торговой организации – 77 000 руб.
    3. Выданы из кассы денежные средства в размере 20 000 руб. подотчетному лицу Смирову А.В,
    4. На расчётный счет поступили денежные средства 30 000 рублей за товары от покупателей;
    5. На сумму 150 000 рублей закуплено оборудование;
    6. Оборудование введено в эксплуатацию.
    7. От Смирнова А.В. поступили товары на сумму 18 000 руб.
    8. В кассу был возвращен неиспользованный остаток денежных средств Смирновым А.В.

    Все вопросы пишите в комментариях, с удовольствием помогу Вам.

    Это может быть интересно:

    Таблицы в Excel представляют собой ряд строк и столбцов со связанными данными, которыми вы управляете независимо друг от друга.

    Работая в Excel с таблицами, вы сможете создавать отчеты, делать расчеты, строить графики и диаграммы, сортировать и фильтровать информацию.

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

    Как работать в Excel с таблицами. Пошаговая инструкция

    Прежде чем работать с таблицами в Эксель, последуйте рекомендациям по организации данных:

  • Данные должны быть организованы в строках и столбцах, причем каждая строка должна содержать информацию об одной записи, например о заказе;
  • Первая строка таблицы должна содержать короткие, уникальные заголовки;
  • Каждый столбец должен содержать один тип данных, таких как числа, валюта или текст;
  • Каждая строка должна содержать данные для одной записи, например, заказа. Если применимо, укажите уникальный идентификатор для каждой строки, например номер заказа;
  • В таблице не должно быть пустых строк и абсолютно пустых столбцов.

    • 1. Выделите область ячеек для создания таблицы

    Как сделать шахматку в excel?

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

    2. Нажмите кнопку “Таблица” на панели быстрого доступа

    На вкладке “Вставка” нажмите кнопку “Таблица”.

    3. Выберите диапазон ячеек

    Как сделать шахматку в excel?

    В всплывающем вы можете скорректировать расположение данных, а также настроить отображение заголовков. Когда все готово, нажмите “ОК”.

    4. Таблица готова. Заполняйте данными!

    Как сделать шахматку в excel?

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

    Форматирование таблицы в Excel

    Для настройки формата таблицы в Экселе доступны предварительно настроенные стили. Все они находятся на вкладке “Конструктор” в разделе “Стили таблиц”:

    Если 7-ми стилей вам мало для выбора, тогда, нажав на кнопку, в правом нижнем углу стилей таблиц, раскроются все доступные стили. В дополнении к предустановленным системой стилям, вы можете настроить свой формат.

    Помимо цветовой гаммы, в меню “Конструктора” таблиц можно настроить:

  • Отображение строки заголовков – включает и отключает заголовки в таблице;
  • Строку итогов – включает и отключает строку с суммой значений в колонках;
  • Чередующиеся строки – подсвечивает цветом чередующиеся строки;
  • Первый столбец – выделяет “жирным” текст в первом столбце с данными;
  • Последний столбец – выделяет “жирным” текст в последнем столбце;
  • Чередующиеся столбцы – подсвечивает цветом чередующиеся столбцы;
  • Кнопка фильтра – добавляет и убирает кнопки фильтра в заголовках столбцов.

    • Как добавить строку или столбец в таблице Excel

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

  • Выберите пункт “Вставить” и кликните левой клавишей мыши по “Столбцы таблицы слева” если хотите добавить столбец, или “Строки таблицы выше”, если хотите вставить строку.

    • Как сделать шахматку в excel?

  • Если вы хотите удалить строку или столбец в таблице, то спуститесь по списку в сплывающем окне до пункта “Удалить” и выберите “Столбцы таблицы”, если хотите удалить столбец или “Строки таблицы”, если хотите удалить строку.

    • Как сделать шахматку в excel?

    Как отсортировать таблицу в Excel

    Для сортировки информации при работе с таблицей, нажмите справа от заголовка колонки “стрелочку”, после чего появится всплывающее окно:

    Как сделать шахматку в excel?

    В окне выберите по какому принципу отсортировать данные: “по возрастанию”, “по убыванию”, “по цвету”, “числовым фильтрам”.

    Как отфильтровать данные в таблице Excel

    Для фильтрации информации в таблице нажмите справа от заголовка колонки “стрелочку”, после чего появится всплывающее окно:

    Как сделать шахматку в excel?

  • “Текстовый фильтр” отображается когда среди данных колонки есть текстовые значения;
  • “Фильтр по цвету” также как и текстовый, доступен когда в таблице есть ячейки, окрашенные в отличающийся от стандартного оформления цвета;
  • “Числовой фильтр” позволяет отобрать данные по параметрам: “Равно…”, “Не равно…”, “Больше…”, “Больше или равно…”, “Меньше…”, “Меньше или равно…”, “Между…”, “Первые 10…”, “Выше среднего”, “Ниже среднего”, а также настроить собственный фильтр.
  • В всплывающем окне, под “Поиском” отображаются все данные, по которым можно произвести фильтрацию, а также одним нажатием выделить все значения или выбрать только пустые ячейки.

    • Если вы хотите отменить все созданные настройки фильтрации, снова откройте всплывающее окно над нужной колонкой и нажмите “Удалить фильтр из столбца”. После этого таблица вернется в исходный вид.

    Как посчитать сумму в таблице Excel

    Для того чтобы посчитать сумму колонки в конце таблицы, нажмите правой клавишей мыши на любой ячейке и вызовите всплывающее окно:

    В списке окна выберите пункт “Таблица” => “Строка итогов”:

    Внизу таблица появится промежуточный итог. Нажмите левой клавишей мыши на ячейке с суммой.

    В выпадающем меню выберите принцип промежуточного итога: это может быть сумма значений колонки, “среднее”, “количество”, “количество чисел”, “максимум”, “минимум” и т.д.

    Как в Excel закрепить шапку таблицы

    Таблицы, с которыми приходится работать, зачастую крупные и содержат в себе десятки строк. Прокручивая таблицу “вниз” сложно ориентироваться в данных, если не видно заголовков столбцов. В Эксель есть возможность закрепить шапку в таблице таким образом, что при прокрутке данных вам будут видны заголовки колонок.

    Для того чтобы закрепить заголовки сделайте следующее:

  • Перейдите на вкладку “Вид” в панели инструментов и выберите пункт “Закрепить области”:
  • Выберите пункт “Закрепить верхнюю строку”:
  • Теперь, прокручивая таблицу, вы не потеряете заголовки и сможете легко сориентироваться где какие данные находятся:

    • Как перевернуть таблицу в Excel

    Представим, что у нас есть готовая таблица с данными продаж по менеджерам:

    На таблице сверху в строках указаны фамилии продавцов, в колонках месяцы. Для того чтобы перевернуть таблицу и разместить месяцы в строках, а фамилии продавцов нужно:

  • Выделить таблицу целиком (зажав левую клавишу мыши выделить все ячейки таблицы) и скопировать данные (CTRL+C):
  • Переместить курсор мыши на свободную ячейку и нажать правую клавишу мыши. В открывшемся меню выбрать “Специальная вставка” и нажать на этом пункте левой клавишей мыши:
  • В открывшемся окне в разделе “Вставить” выбрать “значения” и поставить галочку в пункте “транспонировать”:
  • Готово! Месяцы теперь размещены по строкам, а фамилии продавцов по колонкам. Все что остается сделать – это преобразовать полученные данные в таблицу.

    • В этой статье вы ознакомились с принципами работы в Excel с таблицами, а также основными подходами в их создании. Пишите свои вопросы в комментарии!

    Программа Microsoft Excel удобна для составления таблиц и произведения расчетов. Рабочая область – это множество ячеек, которые можно заполнять данными. Впоследствии – форматировать, использовать для построения графиков, диаграмм, сводных отчетов.

    Работа в Экселе с таблицами для начинающих пользователей может на первый взгляд показаться сложной. Она существенно отличается от принципов построения таблиц в Word. Но начнем мы с малого: с создания и форматирования таблицы. И в конце статьи вы уже будете понимать, что лучшего инструмента для создания таблиц, чем Excel не придумаешь.

    Как создать таблицу в Excel для чайников

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

    Посмотрите внимательно на рабочий лист табличного процессора:

    Это множество ячеек в столбцах и строках. По сути – таблица. Столбцы обозначены латинскими буквами. Строки – цифрами. Если вывести этот лист на печать, получим чистую страницу. Без всяких границ.

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

    Как выделить столбец и строку

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

    Для выделения строки – по названию строки (по цифре).

    Чтобы выделить несколько столбцов или строк, щелкаем левой кнопкой мыши по названию, держим и протаскиваем.

    Для выделения столбца с помощью горячих клавиш ставим курсор в любую ячейку нужного столбца – нажимаем Ctrl + пробел. Для выделения строки – Shift + пробел.

    Как изменить границы ячеек

    Если информация при заполнении таблицы не помещается нужно изменить границы ячеек:

    1. Передвинуть вручную, зацепив границу ячейки левой кнопкой мыши.
    2. Когда длинное слово записано в ячейку, щелкнуть 2 раза по границе столбца / строки. Программа автоматически расширит границы.
    3. Если нужно сохранить ширину столбца, но увеличить высоту строки, воспользуемся кнопкой «Перенос текста» на панели инструментов.

    Для изменения ширины столбцов и высоты строк сразу в определенном диапазоне выделяем область, увеличиваем 1 столбец /строку (передвигаем вручную) – автоматически изменится размер всех выделенных столбцов и строк.

    Примечание. Чтобы вернуть прежний размер, можно нажать кнопку «Отмена» или комбинацию горячих клавиш CTRL+Z. Но она срабатывает тогда, когда делаешь сразу. Позже – не поможет.

    Чтобы вернуть строки в исходные границы, открываем меню инструмента: «Главная»-«Формат» и выбираем «Автоподбор высоты строки»

    Для столбцов такой метод не актуален. Нажимаем «Формат» — «Ширина по умолчанию». Запоминаем эту цифру. Выделяем любую ячейку в столбце, границы которого необходимо «вернуть». Снова «Формат» — «Ширина столбца» — вводим заданный программой показатель (как правило это 8,43 — количество символов шрифта Calibri с размером в 11 пунктов). ОК.

    Как вставить столбец или строку

    Выделяем столбец /строку правее /ниже того места, где нужно вставить новый диапазон. То есть столбец появится слева от выделенной ячейки. А строка – выше.

    Нажимаем правой кнопкой мыши – выбираем в выпадающем меню «Вставить» (или жмем комбинацию горячих клавиш CTRL+SHIFT+»=»).

    Отмечаем «столбец» и жмем ОК.

    Совет. Для быстрой вставки столбца нужно выделить столбец в желаемом месте и нажать CTRL+SHIFT+»=».

    Все эти навыки пригодятся при составлении таблицы в программе Excel. Нам придется расширять границы, добавлять строки /столбцы в процессе работы.

    Пошаговое создание таблицы с формулами

    1. Заполняем вручную шапку – названия столбцов. Вносим данные – заполняем строки. Сразу применяем на практике полученные знания – расширяем границы столбцов, «подбираем» высоту для строк.
    2. Чтобы заполнить графу «Стоимость», ставим курсор в первую ячейку. Пишем «=». Таким образом, мы сигнализируем программе Excel: здесь будет формула. Выделяем ячейку В2 (с первой ценой). Вводим знак умножения (*). Выделяем ячейку С2 (с количеством). Жмем ВВОД.
    3. Когда мы подведем курсор к ячейке с формулой, в правом нижнем углу сформируется крестик. Он указываем на маркер автозаполнения. Цепляем его левой кнопкой мыши и ведем до конца столбца. Формула скопируется во все ячейки.
    4. Обозначим границы нашей таблицы. Выделяем диапазон с данными. Нажимаем кнопку: «Главная»-«Границы» (на главной странице в меню «Шрифт»). И выбираем «Все границы».

    Теперь при печати границы столбцов и строк будут видны.

    С помощью меню «Шрифт» можно форматировать данные таблицы Excel, как в программе Word.

    Поменяйте, к примеру, размер шрифта, сделайте шапку «жирным». Можно установить текст по центру, назначить переносы и т.д.

    Как создать таблицу в Excel: пошаговая инструкция

    Простейший способ создания таблиц уже известен. Но в Excel есть более удобный вариант (в плане последующего форматирования, работы с данными).

    Сделаем «умную» (динамическую) таблицу:

    1. Переходим на вкладку «Вставка» — инструмент «Таблица» (или нажмите комбинацию горячих клавиш CTRL+T).
    2. В открывшемся диалоговом окне указываем диапазон для данных. Отмечаем, что таблица с подзаголовками. Жмем ОК. Ничего страшного, если сразу не угадаете диапазон. «Умная таблица» подвижная, динамическая.

    Примечание. Можно пойти по другому пути – сначала выделить диапазон ячеек, а потом нажать кнопку «Таблица».

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

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

    Как работать с таблицей в Excel

    С выходом новых версий программы работа в Эксель с таблицами стала интересней и динамичней. Когда на листе сформирована умная таблица, становится доступным инструмент «Работа с таблицами» — «Конструктор».

    Здесь мы можем дать имя таблице, изменить размер.

    Доступны различные стили, возможность преобразовать таблицу в обычный диапазон или сводный отчет.

    Возможности динамических электронных таблиц MS Excel огромны. Начнем с элементарных навыков ввода данных и автозаполнения:

    1. Выделяем ячейку, щелкнув по ней левой кнопкой мыши. Вводим текстовое /числовое значение. Жмем ВВОД. Если необходимо изменить значение, снова ставим курсор в эту же ячейку и вводим новые данные.
    2. При введении повторяющихся значений Excel будет распознавать их. Достаточно набрать на клавиатуре несколько символов и нажать Enter.
    3. Чтобы применить в умной таблице формулу для всего столбца, достаточно ввести ее в одну первую ячейку этого столбца. Программа скопирует в остальные ячейки автоматически.
    4. Для подсчета итогов выделяем столбец со значениями плюс пустая ячейка для будущего итога и нажимаем кнопку «Сумма» (группа инструментов «Редактирование» на закладке «Главная» или нажмите комбинацию горячих клавиш ALT+»=»).

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

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

    Did you find apk for android? You can find new Free Android Games and apps.

    Источник

    турнирная таблица — шахматка

    Автор Paha_L, 08.02.2016, 12:19

    « назад — далее »

    может где-нибудь уже есть готовая турнирная таблица — шахматка ?
    и чтобы новых игроков было несложно добавлять.

    А в чём трудность нарисовать такую таблицу? Вы хотя бы начните, фамилии занесите, числа, а уже для счёта и места формулу можно придумать

    1. протягиваю формулу на другие ячейки, не от тех ячеек зависимость делает. надо зеркально от диагонали. например, E10 от L3

    2. последний столбик: надо Очки поделить на количество Игр, и максимальному числу дать 1 Место и тд

    спасибо.
    а можно сделать, чтобы при выделении ячейки в верхней половине, как-то подсвечивалась ячейка в нижней половине которая зависит от первой, чтобы видно было соответствие?

    Средствами Excel — нельзя, на VBA — можно

    а можно сделать, чем больше игр сыграл при равном проценте выигрыша, тем лучше ранг(место)?

    Стремление сделать таблицу — это хорошо, но разноплановые вопросы следует размещать в разных темах.

    Цитата: Paha_L от 11.02.2016, 22:18
    а можно сделать, чем больше игр сыграл при равном проценте выигрыша, тем лучше ранг(место)?

    Можно, конечно. Но зачем?!
    Во всех видах спорта принято считать команду выше, если она сыграла меньше игр чем другая команда с таким же количеством очков…

    ну тогда, как сделать наоборот? больше ранг при меньшем количестве игр.

    Посмотрите такой вариант. Доп. столбец АК можно скрыть. Формулу в основной таблице тоже немного поменяла, чтобы пол-очка учитывались

    в таком рейтинге как раз, кто больше игр сыграл, тот и имеет преимущество.

    Я так поняла, что в первую очередь смотрится кол-во очков, а уже если кол-во очков одинаковое, должно учитываться кол-во игр. Нет?

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

    Цитата: Paha_L от 15.02.2016, 21:56
    в первую очередь процент выигранных игр, а потом кол-во игр сравнивать.

    То есть если человек сыграл 1 игру и выиграл, то у него место будет выше, чем у сыгравшего 4 игры, из которых 3 выигрыша? По-моему не очень справедливо

    • Профессиональные приемы работы в Microsoft Excel
    • ►
      Обмен опытом
    • ►
      Microsoft Excel
    • ►
      турнирная таблица — шахматка

    Источник

    Создание таблицы (шахматки) макросом

    champ

    		 Дата: Понедельник, 19.12.2016, 12:54 |
    Сообщение № 1

    Группа: Пользователи

    Ранг: Новичок

    Сообщений: 37


    Репутация:
    0
    ±

    Замечаний:
    0% ±


    Excel 2010

    Здравствуйте,
    понял, что задача решается только макросом, поэтому прошу помочь с решением или подсказать в каком направлении двигаться.
    В ячейках B3:А8 вручную заносятся результаты игр — это исходные данные.
    Необходимо сформировать в ячейках C13:O16 таблицу-шахматку на основе данных ячеек B3:А8.
    Причем позиции в ячейках C13:C16 расставить в соответствии с ячейками W13:W16, Y13:Z16

    К сообщению приложен файл:

    1923662.xlsx
    (11.3 Kb)
     

    Ответить

    dim34rus

    		 Дата: Понедельник, 19.12.2016, 18:29 |
    Сообщение № 2

    Группа: Пользователи

    Ранг: Участник

    Сообщений: 66


    Репутация:
    10
    ±

    Замечаний:
    0% ±


    Excel 2007 — 2013

    Количество игроков фиксировано, или «задача» предусматривает решение для 5-6-…n игроков?
    Результат всегда окончательный, т.е. имеются результаты по всем играм, или частично?
    Если результат по частичным играм, то игровые пары, которые еще не сыграны будут указаны в первоначальной таблице или нет?

    Жду ответов, и … приступаем!

    Извращение — это писать формулы в Word’овских таблицах.
    ЯД 410014340958327

     

    Ответить

    champ

    		 Дата: Понедельник, 19.12.2016, 19:05 |
    Сообщение № 3

    Группа: Пользователи

    Ранг: Новичок

    Сообщений: 37


    Репутация:
    0
    ±

    Замечаний:
    0% ±


    Excel 2010

    В идеале конечно лучше для n игроков, насчет результатов, могут быть следующие:
    -3:1 ; 2:2; 1:4; в:п, н:н, п:в; w:0; 0:w или пусто (матч еще не сыгран или неизвестен результат).
    цифры могут разные в первых трех исходах.
    в:п победа первого , без указания счета
    п:в — второго, без указания счета
    н:н — ничья, без указания счета
    w:0 — победа первого техническая(неявка второго)
    0:w — победа второго техническая(неявка первого)
    победа, победа первого техническая — 3 очка,
    ничья — 2 очка,
    проигрыш — 1 очко
    поражение техническое (неявка) — 0 очков.

    Сообщение отредактировал champ — Понедельник, 19.12.2016, 19:06
     

    Ответить

    dim34rus

    		 Дата: Вторник, 20.12.2016, 01:39 |
    Сообщение № 4

    Группа: Пользователи

    Ранг: Участник

    Сообщений: 66


    Репутация:
    10
    ±

    Замечаний:
    0% ±


    Excel 2007 — 2013

    Еще немного терпения и будет Щастье.
    А если интересно направление действий, то Вашу первоначальную таблицу засовываем в трехмерный массив, выдергиваем оттуда всю полезную инфу в двумерный массив с результатами (табличка радом с шахматкой)
    А делее… (как раз пока здесь на данный момент и остановился)
    1. Сортируем двумерный массив по возрастанию очков и прочей лабуды (Кстати про прочую лабуду: при одинаковом количестве очков я так думаю первого ставим того, у кого разница забитых пропущенных лучше, а и при их равенстве — у кого больше забитых)
    2. И далее самое «вкусное» сортировка трехмерного массива в двумерном пространстве :-)

    ну и напоследок все это счастье кинуть на лист1

    Извращение — это писать формулы в Word’овских таблицах.
    ЯД 410014340958327

     

    Ответить

    dim34rus

    		 Дата: Вторник, 20.12.2016, 17:35 |
    Сообщение № 5

    Группа: Пользователи

    Ранг: Участник

    Сообщений: 66


    Репутация:
    10
    ±

    Замечаний:
    0% ±


    Excel 2007 — 2013

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

    Код сюда не кидаю, ибо он большой с функциями и прочей лабудой. Все в файле во вложении

    PS: Очистка форматирования пока не реализована. так что форматирование чистим ручками

    К сообщению приложен файл:

    2993195.xlsm
    (41.6 Kb)

    Извращение — это писать формулы в Word’овских таблицах.
    ЯД 410014340958327

     

    Ответить

    champ

    		 Дата: Вторник, 20.12.2016, 19:08 |
    Сообщение № 6

    Группа: Пользователи

    Ранг: Новичок

    Сообщений: 37


    Репутация:
    0
    ±

    Замечаний:
    0% ±


    Excel 2010

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

    Ответить

    dim34rus

    		 Дата: Вторник, 20.12.2016, 19:39 |
    Сообщение № 7

    Группа: Пользователи

    Ранг: Участник

    Сообщений: 66


    Репутация:
    10
    ±

    Замечаний:
    0% ±


    Excel 2007 — 2013

    чтобы команды по ранжиру расставлялись автоматически,

    :'(
    Дык. ёлы-палы. Они же по ранжиру в шахматке и расставляются

    Извращение — это писать формулы в Word’овских таблицах.
    ЯД 410014340958327

     

    Ответить

    champ

    		 Дата: Вторник, 20.12.2016, 21:04 |
    Сообщение № 8

    Группа: Пользователи

    Ранг: Новичок

    Сообщений: 37


    Репутация:
    0
    ±

    Замечаний:
    0% ±


    Excel 2010

    Да это я не туда посмотрел, все верно.
     

    Ответить

    champ

    		 Дата: Пятница, 23.12.2016, 21:34 |
    Сообщение № 9

    Группа: Пользователи

    Ранг: Новичок

    Сообщений: 37


    Репутация:
    0
    ±

    Замечаний:
    0% ±


    Excel 2010

    dim34rus, есть несколько вопросов
    1. на листе 1 — названия не проставляются, вместо названий «$A$», соответственно и на листе 2 тоже самое вместо названий
    2 на листе 1 — автоматически расставляются пары , хотя они могут быть и в другом порядке
    на листе 3 привел свои данные
     

    Ответить

    dim34rus

    		 Дата: Суббота, 24.12.2016, 13:05 |
    Сообщение № 10

    Группа: Пользователи

    Ранг: Участник

    Сообщений: 66


    Репутация:
    10
    ±

    Замечаний:
    0% ±


    Excel 2007 — 2013

    1. Мне нужно было взять какие-то названия, а придумывать их лень :-) и вот это они. Можно отдельно реализовать опрос по наименованию команд, а можно заранее приготовленный список с листа взять
    2. Пары можно пересортировать как пожелаете, на итоговый результат это никак не влияет

    На листе 3 вы не указали еще 3 пары. (ну это так к слову…)

    Что-бы было все «Зе битлз»:
    1) Выделите на листе1 место (колонку) в которой будут указаны все названия команд, я из них тогда буду составлять список.
    2) В дополнительной колонке к результату игровой пары можно предусмотреть дату, тогда после заполнения этой колонки игры можно будет отсортировать
    3) В шахматке можно будет сделать дату через примечание (при наведении на ячейку будет показывать дату игры :-) )

    Извращение — это писать формулы в Word’овских таблицах.
    ЯД 410014340958327

     

    Ответить

    champ

    		 Дата: Суббота, 24.12.2016, 17:53 |
    Сообщение № 11

    Группа: Пользователи

    Ранг: Новичок

    Сообщений: 37


    Репутация:
    0
    ±

    Замечаний:
    0% ±


    Excel 2010

    в приложенном файле указал : название команд и даты
    в конкретном примере некоторые матчи не доиграны и их нет в списке игр или их лучше добавить ?
    Можно ли будет сделать шахматку не только на конец турнира, на определенную дату?
     

    Ответить

    dim34rus

    		 Дата: Понедельник, 26.12.2016, 17:46 |
    Сообщение № 12

    Группа: Пользователи

    Ранг: Участник

    Сообщений: 66


    Репутация:
    10
    ±

    Замечаний:
    0% ±


    Excel 2007 — 2013

    Доделал.
    1. Количество и наименования команд берет из списка
    2. Колонка даты, если заполнена (даже для несыгранной игры) — выводится в качестве примечания в шахматке
    В принципе там может быть и не дата, а все что пожелаете, хоть составы обоих команд
    3. При перезаполнении игровых пар на первом листе вся таблица очищается
    4. При формировании шахматки — полностью очищается и динамически переоформляется.
    5. Порядок сортировки игровых пар на первом листе не влияет на результаты шахматки
    6. Можно записывать баскетбольный счет, т.е корректно будет отрабатывать до 150 забитых голов любой командой в любом матче

    ЗЫЖ Даже если игра не сыграна — логично, что игровая пара на первом листе определена.

    Для полноты ощущения, по хорошему, надо сделать защиту от «дурака», чтобы можно было вводить только корректные данные и поставить динамический блокировки различных ячеек (от шаловливых ручонок)

    К сообщению приложен файл:

    5118582.xlsm
    (66.0 Kb)

    Извращение — это писать формулы в Word’овских таблицах.
    ЯД 410014340958327

    Сообщение отредактировал dim34rus — Понедельник, 26.12.2016, 17:56
     

    Ответить

    champ

    		 Дата: Вторник, 27.12.2016, 16:16 |
    Сообщение № 13

    Группа: Пользователи

    Ранг: Новичок

    Сообщений: 37


    Репутация:
    0
    ±

    Замечаний:
    0% ±


    Excel 2010

    dim34rus, все работает как надо. Благодарю.
    Количество команд любое , неограничено? Если подсчет очков изменить на другой , например 3-1-0 (в-н-п) или 2-1-0, что надо изменить?
     

    Ответить

    dim34rus

    		 Дата: Вторник, 27.12.2016, 17:59 |
    Сообщение № 14

    Группа: Пользователи

    Ранг: Участник

    Сообщений: 66


    Репутация:
    10
    ±

    Замечаний:
    0% ±


    Excel 2007 — 2013

    например 3-1-0 (в-н-п) или 2-1-0, что надо изменить?

    это в коде надо менять

    [vba]

    Код

           ‘Считаем результаты и очки
           If mas_igr(Com1, Com2, 0) > mas_igr(Com1, Com2, 1) Then
              mas_result(Com1, 1) = mas_result(Com1, 1) + 1
              mas_result(Com2, 3) = mas_result(Com2, 3) + 1
              mas_result(Com1, 4) = mas_result(Com1, 4) + 3
              mas_result(Com2, 4) = mas_result(Com2, 4) + 1
           End If

                  If mas_igr(Com1, Com2, 0) < mas_igr(Com1, Com2, 1) Then
              mas_result(Com2, 1) = mas_result(Com2, 1) + 1
              mas_result(Com1, 3) = mas_result(Com1, 3) + 1
              mas_result(Com2, 4) = mas_result(Com2, 4) + 3
              mas_result(Com1, 4) = mas_result(Com1, 4) + 1
           End If

    [/vba]

    здесь 3 на 2
    [vba]

    Код

           mas_result(Com1, 4) = mas_result(Com1, 4) + 3

    [/vba]

    и здесь 3 на 2
    [vba]

    Код

           mas_result(Com2, 4) = mas_result(Com2, 4) + 3

    [/vba]

    Извращение — это писать формулы в Word’овских таблицах.
    ЯД 410014340958327

     

    Ответить

    champ

    		 Дата: Среда, 28.12.2016, 20:50 |
    Сообщение № 15

    Группа: Пользователи

    Ранг: Новичок

    Сообщений: 37


    Репутация:
    0
    ±

    Замечаний:
    0% ±


    Excel 2010

    dim34rus, спасибо.. Есть еще варианты турниров когда команды друг с другом по 2 встречи играют (дома, в гостях).
     

    Ответить
    Источник

    Понравилась статья? Поделить с друзьями:
  • Таблица в excel цифры с запятой
  • Таблица в word прилипла к верху страницы
  • Таблица в excel формула скачать
  • Таблица в excel формула итого
  • Таблица в excel фио сотрудника