Транспонирование КонтрАгентов
vova-vba
Дата: Воскресенье, 19.02.2017, 02:29 |
Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация:
-1
±
Замечаний:
0% ±
Excel 2010
Имеется таблица доходы по контрагентам по кварталам, требуется транспонировать в одну строку по месяцам, т.е таблицу вот такого вида : Наименование организации 1мес 2мес 3мес Квартал Первый 1 1 1 2 Первый 1 1 1 3 Первый 1 1 1 4 КонтрАгент1 1111 1111 1111 1 Фирма12 2 22 2 1 Фирма12 222 2 2 2 2агент 4545 67 67 1 2агент 4545 67 67 2 2агент 4545 67 454 3 2агент 4545 67 454 4 КонтрАгент3 333 333 333 3 Фирма 656 454 67 1 Фирма 5656 345 67 2 Фирма 854 65 67 3 Магазин 55 55 11 3 Магазин 55 55 67 4 СуперМаркет 34 7676 67 1 СуперМаркет 34 7676 67 2 СуперМаркет 34 7676 67 3 СуперМаркет 34 7676 454 4 КонтрАгент4 444 444 444 4 Ларек 234 234 454 1 Ларек 234 234 11 2 Ларек 234 234 67 3 СтройМатериалы 545 455 67 1 СтройМатериалы 545 455 67 2 СтройМатериалы 545 455 67 3 СтройМатериалы 545 455 454 4 КонтрАгент2 222 222 222 2 Аптека 656 45 67 2 Аптека 656 45 454 3 Аптека 656 45 454 4 Магазин123 55 55 11 2 Магазин123 55 55 67 3 получить таблицу вот такого вида : Наименование организации 1мес 2мес 3мес Квартал 1 2 3 4 5 6 7 8 9 10 11 12 Первый 1 1 1 2 1 1 1 1 1 1 1 1 1 Первый 1 1 1 3 Первый 1 1 1 4 КонтрАгент1 1111 1111 1111 1 1111 1111 1111 Фирма12 2 22 2 1 2 22 2 222 2 2 Фирма12 222 2 2 2 2агент 4545 67 67 1 4545 67 67 4545 67 67 4545 67 454 4545 67 454 2агент 4545 67 67 2 2агент 4545 67 454 3 2агент 4545 67 454 4 КонтрАгент3 333 333 333 3 333 333 333 Фирма 656 454 67 1 656 454 67 5656 345 67 854 65 67 Фирма 5656 345 67 2 Фирма 854 65 67 3 Магазин 55 55 11 3 55 55 11 55 55 67 Магазин 55 55 67 4 СуперМаркет 34 7676 67 1 34 7676 67 34 7676 67 34 7676 67 34 7676 454 СуперМаркет 34 7676 67 2 СуперМаркет 34 7676 67 3 СуперМаркет 34 7676 454 4 КонтрАгент4 444 444 444 4 444 444 444 Ларек 234 234 454 1 234 234 454 234 234 11 234 234 67 Ларек 234 234 11 2 Ларек 234 234 67 3 СтройМатериалы 545 455 67 1 545 455 67 545 455 67 545 455 67 545 455 454 СтройМатериалы 545 455 67 2 СтройМатериалы 545 455 67 3 СтройМатериалы 545 455 454 4 КонтрАгент2 222 222 222 2 222 222 222 Аптека 656 45 67 2 656 45 67 656 45 454 656 45 454 Аптека 656 45 454 3 Аптека 656 45 454 4 Магазин123 55 55 11 2 55 55 11 55 55 67 Магазин123 55 55 67 3 сам файл прилагаю
Имеется таблица доходы по контрагентам по кварталам, требуется транспонировать в одну строку по месяцам, т.е таблицу вот такого вида : Наименование организации 1мес 2мес 3мес Квартал Первый 1 1 1 2 Первый 1 1 1 3 Первый 1 1 1 4 КонтрАгент1 1111 1111 1111 1 Фирма12 2 22 2 1 Фирма12 222 2 2 2 2агент 4545 67 67 1 2агент 4545 67 67 2 2агент 4545 67 454 3 2агент 4545 67 454 4 КонтрАгент3 333 333 333 3 Фирма 656 454 67 1 Фирма 5656 345 67 2 Фирма 854 65 67 3 Магазин 55 55 11 3 Магазин 55 55 67 4 СуперМаркет 34 7676 67 1 СуперМаркет 34 7676 67 2 СуперМаркет 34 7676 67 3 СуперМаркет 34 7676 454 4 КонтрАгент4 444 444 444 4 Ларек 234 234 454 1 Ларек 234 234 11 2 Ларек 234 234 67 3 СтройМатериалы 545 455 67 1 СтройМатериалы 545 455 67 2 СтройМатериалы 545 455 67 3 СтройМатериалы 545 455 454 4 КонтрАгент2 222 222 222 2 Аптека 656 45 67 2 Аптека 656 45 454 3 Аптека 656 45 454 4 Магазин123 55 55 11 2 Магазин123 55 55 67 3 получить таблицу вот такого вида : Наименование организации 1мес 2мес 3мес Квартал 1 2 3 4 5 6 7 8 9 10 11 12 Первый 1 1 1 2 1 1 1 1 1 1 1 1 1 Первый 1 1 1 3 Первый 1 1 1 4 КонтрАгент1 1111 1111 1111 1 1111 1111 1111 Фирма12 2 22 2 1 2 22 2 222 2 2 Фирма12 222 2 2 2 2агент 4545 67 67 1 4545 67 67 4545 67 67 4545 67 454 4545 67 454 2агент 4545 67 67 2 2агент 4545 67 454 3 2агент 4545 67 454 4 КонтрАгент3 333 333 333 3 333 333 333 Фирма 656 454 67 1 656 454 67 5656 345 67 854 65 67 Фирма 5656 345 67 2 Фирма 854 65 67 3 Магазин 55 55 11 3 55 55 11 55 55 67 Магазин 55 55 67 4 СуперМаркет 34 7676 67 1 34 7676 67 34 7676 67 34 7676 67 34 7676 454 СуперМаркет 34 7676 67 2 СуперМаркет 34 7676 67 3 СуперМаркет 34 7676 454 4 КонтрАгент4 444 444 444 4 444 444 444 Ларек 234 234 454 1 234 234 454 234 234 11 234 234 67 Ларек 234 234 11 2 Ларек 234 234 67 3 СтройМатериалы 545 455 67 1 545 455 67 545 455 67 545 455 67 545 455 454 СтройМатериалы 545 455 67 2 СтройМатериалы 545 455 67 3 СтройМатериалы 545 455 454 4 КонтрАгент2 222 222 222 2 222 222 222 Аптека 656 45 67 2 656 45 67 656 45 454 656 45 454 Аптека 656 45 454 3 Аптека 656 45 454 4 Магазин123 55 55 11 2 55 55 11 55 55 67 Магазин123 55 55 67 3 сам файл прилагаю vova-vba
К сообщению приложен файл:
__.rar
(54.4 Kb)
Сообщение отредактировал vova-vba - Воскресенье, 19.02.2017, 02:29
Ответить
Сообщение Имеется таблица доходы по контрагентам по кварталам, требуется транспонировать в одну строку по месяцам, т.е таблицу вот такого вида : Наименование организации 1мес 2мес 3мес Квартал Первый 1 1 1 2 Первый 1 1 1 3 Первый 1 1 1 4 КонтрАгент1 1111 1111 1111 1 Фирма12 2 22 2 1 Фирма12 222 2 2 2 2агент 4545 67 67 1 2агент 4545 67 67 2 2агент 4545 67 454 3 2агент 4545 67 454 4 КонтрАгент3 333 333 333 3 Фирма 656 454 67 1 Фирма 5656 345 67 2 Фирма 854 65 67 3 Магазин 55 55 11 3 Магазин 55 55 67 4 СуперМаркет 34 7676 67 1 СуперМаркет 34 7676 67 2 СуперМаркет 34 7676 67 3 СуперМаркет 34 7676 454 4 КонтрАгент4 444 444 444 4 Ларек 234 234 454 1 Ларек 234 234 11 2 Ларек 234 234 67 3 СтройМатериалы 545 455 67 1 СтройМатериалы 545 455 67 2 СтройМатериалы 545 455 67 3 СтройМатериалы 545 455 454 4 КонтрАгент2 222 222 222 2 Аптека 656 45 67 2 Аптека 656 45 454 3 Аптека 656 45 454 4 Магазин123 55 55 11 2 Магазин123 55 55 67 3 получить таблицу вот такого вида : Наименование организации 1мес 2мес 3мес Квартал 1 2 3 4 5 6 7 8 9 10 11 12 Первый 1 1 1 2 1 1 1 1 1 1 1 1 1 Первый 1 1 1 3 Первый 1 1 1 4 КонтрАгент1 1111 1111 1111 1 1111 1111 1111 Фирма12 2 22 2 1 2 22 2 222 2 2 Фирма12 222 2 2 2 2агент 4545 67 67 1 4545 67 67 4545 67 67 4545 67 454 4545 67 454 2агент 4545 67 67 2 2агент 4545 67 454 3 2агент 4545 67 454 4 КонтрАгент3 333 333 333 3 333 333 333 Фирма 656 454 67 1 656 454 67 5656 345 67 854 65 67 Фирма 5656 345 67 2 Фирма 854 65 67 3 Магазин 55 55 11 3 55 55 11 55 55 67 Магазин 55 55 67 4 СуперМаркет 34 7676 67 1 34 7676 67 34 7676 67 34 7676 67 34 7676 454 СуперМаркет 34 7676 67 2 СуперМаркет 34 7676 67 3 СуперМаркет 34 7676 454 4 КонтрАгент4 444 444 444 4 444 444 444 Ларек 234 234 454 1 234 234 454 234 234 11 234 234 67 Ларек 234 234 11 2 Ларек 234 234 67 3 СтройМатериалы 545 455 67 1 545 455 67 545 455 67 545 455 67 545 455 454 СтройМатериалы 545 455 67 2 СтройМатериалы 545 455 67 3 СтройМатериалы 545 455 454 4 КонтрАгент2 222 222 222 2 222 222 222 Аптека 656 45 67 2 656 45 67 656 45 454 656 45 454 Аптека 656 45 454 3 Аптека 656 45 454 4 Магазин123 55 55 11 2 55 55 11 55 55 67 Магазин123 55 55 67 3 сам файл прилагаю Автор - vova-vba Дата добавления - 19.02.2017 в 02:29
vova-vba
Дата: Воскресенье, 19.02.2017, 02:35 |
Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация:
-1
±
Замечаний:
0% ±
Excel 2010
Так то сам код готов , работает нормально , вопрос в следующем , можно ли более оптимально и красивей или возможно существуют какие то стандартные методы
Так то сам код готов , работает нормально , вопрос в следующем , можно ли более оптимально и красивей или возможно существуют какие то стандартные методы vova-vba
Ответить
Сообщение Так то сам код готов , работает нормально , вопрос в следующем , можно ли более оптимально и красивей или возможно существуют какие то стандартные методы Автор - vova-vba Дата добавления - 19.02.2017 в 02:35
gling
Дата: Воскресенье, 19.02.2017, 09:30 |
Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2519
Репутация:
674
±
Замечаний:
0% ±
2010
Красиво или нет не знаю, но короче это точно. [vba]Код
Sub Кнопка2() Dim i As Long, j As Long, jj As Long, lLastRow As Long Application.ScreenUpdating = False lLastRow = Cells(Rows.Count, 1).End(xlUp).Row Range("F2:Q" & lLastRow).Clear For j = 2 To lLastRow jj = Application.Match(Cells(j, 1), Range("A1:A" & lLastRow), 0) For i = 1 To 3 Range(Cells(j, 2), Cells(j, 4)).Copy Cells(jj, 3 + 3 * Cells(j, 5)) Next Next Range("F2:Q" & lLastRow).Borders.LineStyle = xlContinuous Application.ScreenUpdating = True End Sub
[/vba]Кросс
Красиво или нет не знаю, но короче это точно. [vba]Код
Sub Кнопка2() Dim i As Long, j As Long, jj As Long, lLastRow As Long Application.ScreenUpdating = False lLastRow = Cells(Rows.Count, 1).End(xlUp).Row Range("F2:Q" & lLastRow).Clear For j = 2 To lLastRow jj = Application.Match(Cells(j, 1), Range("A1:A" & lLastRow), 0) For i = 1 To 3 Range(Cells(j, 2), Cells(j, 4)).Copy Cells(jj, 3 + 3 * Cells(j, 5)) Next Next Range("F2:Q" & lLastRow).Borders.LineStyle = xlContinuous Application.ScreenUpdating = True End Sub
[/vba]Кросс gling
ЯД-41001506838083
Сообщение отредактировал gling - Воскресенье, 19.02.2017, 09:44
Ответить
Сообщение Красиво или нет не знаю, но короче это точно. [vba]Код
Sub Кнопка2() Dim i As Long, j As Long, jj As Long, lLastRow As Long Application.ScreenUpdating = False lLastRow = Cells(Rows.Count, 1).End(xlUp).Row Range("F2:Q" & lLastRow).Clear For j = 2 To lLastRow jj = Application.Match(Cells(j, 1), Range("A1:A" & lLastRow), 0) For i = 1 To 3 Range(Cells(j, 2), Cells(j, 4)).Copy Cells(jj, 3 + 3 * Cells(j, 5)) Next Next Range("F2:Q" & lLastRow).Borders.LineStyle = xlContinuous Application.ScreenUpdating = True End Sub
[/vba]Кросс Автор - gling Дата добавления - 19.02.2017 в 09:30
vova-vba
Дата: Воскресенье, 19.02.2017, 11:17 |
Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация:
-1
±
Замечаний:
0% ±
Excel 2010
gling , вообще красота, я даже как после нокаута не могу понять от куда прилетело , сейчас сижу разбираю по буквам, вообщем высший пилотаж, я сейчас это дело зашаблоню сделаю что то типа загатовки шаблона большое спасибо
gling , вообще красота, я даже как после нокаута не могу понять от куда прилетело , сейчас сижу разбираю по буквам, вообщем высший пилотаж, я сейчас это дело зашаблоню сделаю что то типа загатовки шаблона большое спасибоvova-vba
Ответить
Сообщение gling , вообще красота, я даже как после нокаута не могу понять от куда прилетело , сейчас сижу разбираю по буквам, вообщем высший пилотаж, я сейчас это дело зашаблоню сделаю что то типа загатовки шаблона большое спасибоАвтор - vova-vba Дата добавления - 19.02.2017 в 11:17
gling
Дата: Воскресенье, 19.02.2017, 11:37 |
Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2519
Репутация:
674
±
Замечаний:
0% ±
2010
Для чего создавал переменную i, не знаю, можно без неё. В коде уберите i As Long, For i = 1 To 3 и Next Получится так[vba]Код
Sub Кнопка2() Dim j As Long, jj As Long, lLastRow As Long Application.ScreenUpdating = False lLastRow = Cells(Rows.Count, 1).End(xlUp).Row Range("F2:Q" & lLastRow).Clear For j = 2 To lLastRow jj = Application.Match(Cells(j, 1), Range("A1:A" & lLastRow), 0) Range(Cells(j, 2), Cells(j, 4)).Copy Cells(jj, 3 + 3 * Cells(j, 5)) Next Range("F2:Q" & lLastRow).Borders.LineStyle = xlContinuous Application.ScreenUpdating = True End Sub
[/vba]
Для чего создавал переменную i, не знаю, можно без неё. В коде уберите i As Long, For i = 1 To 3 и Next Получится так[vba]Код
Sub Кнопка2() Dim j As Long, jj As Long, lLastRow As Long Application.ScreenUpdating = False lLastRow = Cells(Rows.Count, 1).End(xlUp).Row Range("F2:Q" & lLastRow).Clear For j = 2 To lLastRow jj = Application.Match(Cells(j, 1), Range("A1:A" & lLastRow), 0) Range(Cells(j, 2), Cells(j, 4)).Copy Cells(jj, 3 + 3 * Cells(j, 5)) Next Range("F2:Q" & lLastRow).Borders.LineStyle = xlContinuous Application.ScreenUpdating = True End Sub
[/vba] gling
ЯД-41001506838083
Сообщение отредактировал gling - Воскресенье, 19.02.2017, 11:40
Ответить
Сообщение Для чего создавал переменную i, не знаю, можно без неё. В коде уберите i As Long, For i = 1 To 3 и Next Получится так[vba]Код
Sub Кнопка2() Dim j As Long, jj As Long, lLastRow As Long Application.ScreenUpdating = False lLastRow = Cells(Rows.Count, 1).End(xlUp).Row Range("F2:Q" & lLastRow).Clear For j = 2 To lLastRow jj = Application.Match(Cells(j, 1), Range("A1:A" & lLastRow), 0) Range(Cells(j, 2), Cells(j, 4)).Copy Cells(jj, 3 + 3 * Cells(j, 5)) Next Range("F2:Q" & lLastRow).Borders.LineStyle = xlContinuous Application.ScreenUpdating = True End Sub
[/vba] Автор - gling Дата добавления - 19.02.2017 в 11:37
KuklP
Дата: Воскресенье, 19.02.2017, 11:47 |
Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация:
486
±
Замечаний:
0% ±
2003-2010
Ну с НДС и мы чего-то стoим! kuklp60@gmail.com WM Z206653985942, R334086032478, U238399322728
Ответить
vova-vba
Дата: Воскресенье, 19.02.2017, 11:57 |
Сообщение № 7
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация:
-1
±
Замечаний:
0% ±
Excel 2010
Для чего создавал переменную i, не знаю, можно без неё. В коде уберите i As Long, For i = 1 To 3 и Next Получится так
ОК , спасибо
Для чего создавал переменную i, не знаю, можно без неё. В коде уберите i As Long, For i = 1 To 3 и Next Получится так
ОК , спасибоvova-vba
Ответить
Сообщение Для чего создавал переменную i, не знаю, можно без неё. В коде уберите i As Long, For i = 1 To 3 и Next Получится так
ОК , спасибоАвтор - vova-vba Дата добавления - 19.02.2017 в 11:57
vova-vba
Дата: Воскресенье, 19.02.2017, 12:06 |
Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация:
-1
±
Замечаний:
0% ±
Excel 2010
gling к стате быстрей работает
Ответить
Сообщение gling к стате быстрей работает Автор - vova-vba Дата добавления - 19.02.2017 в 12:06
vova-vba
Дата: Воскресенье, 19.02.2017, 12:11 |
Сообщение № 9
Группа: Пользователи
Ранг: Прохожий
Сообщений: 6
Репутация:
-1
±
Замечаний:
0% ±
Excel 2010
а дальше больше , у меня вот так работает [vba]Код
Sub Êíîïêà2() For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row jj = Application.Match(Cells(j, 1), Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row), 0) Range(Cells(j, 2), Cells(j, 4)).Copy Cells(jj, 3 + 3 * Cells(j, 5)) Next End Sub
[/vba]
а дальше больше , у меня вот так работает [vba]Код
Sub Êíîïêà2() For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row jj = Application.Match(Cells(j, 1), Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row), 0) Range(Cells(j, 2), Cells(j, 4)).Copy Cells(jj, 3 + 3 * Cells(j, 5)) Next End Sub
[/vba] vova-vba
Ответить
Сообщение а дальше больше , у меня вот так работает [vba]Код
Sub Êíîïêà2() For j = 2 To Cells(Rows.Count, 1).End(xlUp).Row jj = Application.Match(Cells(j, 1), Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row), 0) Range(Cells(j, 2), Cells(j, 4)).Copy Cells(jj, 3 + 3 * Cells(j, 5)) Next End Sub
[/vba] Автор - vova-vba Дата добавления - 19.02.2017 в 12:11
gling
Дата: Воскресенье, 19.02.2017, 12:19 |
Сообщение № 10
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2519
Репутация:
674
±
Замечаний:
0% ±
2010
Из-за Ваших оскорблений, на дружественном форуме, у меня нет желания с вами общаться, и объяснять почему прописаны дополнительные строки, и какие ошибки выскочат при вашем написании кода. Доходите до всего самостоятельно. Удачи.
Из-за Ваших оскорблений, на дружественном форуме, у меня нет желания с вами общаться, и объяснять почему прописаны дополнительные строки, и какие ошибки выскочат при вашем написании кода. Доходите до всего самостоятельно. Удачи. gling
ЯД-41001506838083
Ответить
Сообщение Из-за Ваших оскорблений, на дружественном форуме, у меня нет желания с вами общаться, и объяснять почему прописаны дополнительные строки, и какие ошибки выскочат при вашем написании кода. Доходите до всего самостоятельно. Удачи. Автор - gling Дата добавления - 19.02.2017 в 12:19