Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.63/8: Рейтинг темы: голосов - 8, средняя оценка - 4.63
12 / 12 / 2
Регистрация: 27.11.2011
Сообщений: 652
1

По содержимому столбца создать листы и в эти листы скопировать соответствующие строки

10.05.2013, 16:37. Просмотров 1615. Ответов 14
Метки нет (Все метки)

Здравствуйте, уважаемые Форумчане!!! Есть задачка: В прикреплённом файле есть табличка. Надо по содержимому колонки, например отдел, создать листы и в эти листы скопировать из листа "Главная" строки по этому отделу. Например: по отделу столовая создаётся лист столовая и туда копируются все из этого отдела, затем создаётся лист Сбыт и туда копируются все из отдела Сбыта и т.д. по всей колонке. Я начал писать макрос, но что-то выдаёт ошибки. Помогите пожалуйста. Спасибо заранее!!!
0
Вложения
Тип файла: xls Кадры.xls (38.0 Кб, 31 просмотров)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
10.05.2013, 16:37
Ответы с готовыми решениями:

НА ЭКСЕЛЕ БАЗА ДАННЫХ .Создать листы "сотрудники" кафедры","дисциплины". и с помощью ВПР и СУММЕСЛИ связать эти листы
Предметная область: Учебно-методическое управление (профессорско-преподавательский состав)....

Скопировать, перенести и объединить листы
доброго времени суток подскажите пожалуйста как перенести и объединить листы? Лист1 Лист2...

Скопировать листы книги, начиная с третьего
Добрый день! Подскажите, пожалуйста, как скопировать все листы Книги, начиная с 3его листа (1ый и...

Скопировать заданный диапазон на указанные листы
Всем доброго времени суток. Что-то никак не могу сообразить как сделать макрос чтобы заранее...

14
6650 / 2663 / 495
Регистрация: 19.10.2012
Сообщений: 8,046
10.05.2013, 17:29 2
Тупо в лоб думаю такой алгоритм - перебор строк (ну даже как у Вас), проверяем наличие листа.
Если нет - добавляем лист, пишем туда шапку (ну или копируем её из этого листа).
Далее определяем свободную строку, копируем строку.
Вроде всё просто... Напишите сами?
0
3183 / 938 / 216
Регистрация: 29.05.2010
Сообщений: 2,046
10.05.2013, 17:35 3
Есть и такой вариант, может подойдет
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Kadry()
    Dim shSrc As Worksheet, rCol1 As Range, c As Range
    Dim cl As New Collection
    Set shSrc = ActiveSheet
    Set rCol1 = shSrc.UsedRange.Columns(4)
    Set rCol1 = rCol1.Cells(2).Resize(rCol1.Cells.Count - 1) 'ñòîëáåö áåç çàãîëîâêà
    On Error Resume Next
    For Each c In rCol1.Cells
        cl.Add 0, c.Value
        If Err Then         'çíà÷åíèå íå óíèêàëüíî
            Err.Clear
        Else                'çíà÷åíèå óíèêàëüíî
            shSrc.Copy After:=Sheets(Sheets.Count)     'íîâûé ëèñò
            ActiveSheet.Name = c
                            'óäàëèòü ñòðîêè ñ íåñîâïàäàþùèì ïåðâûì ñòîëáöîì
            ActiveSheet.Range(rCol1.Address).ColumnDifferences(c).EntireRow.Delete
            shSrc.Activate
        End If
    Next
End Sub
1
6650 / 2663 / 495
Регистрация: 19.10.2012
Сообщений: 8,046
10.05.2013, 17:46 4
Минимально переделав Ваш код:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Kadry()
    Dim sh As Worksheet, s$, i&
 
    On Error Resume Next
    With Worksheets("Главная")
 
        i = 2
        While .Cells(i, 4) <> ""
            s = .Cells(i, 4)
            Set sh = Sheets(s)
            If sh Is Nothing Then
                Worksheets.Add.Name = s
                .Rows(1).Copy Sheets(s).Range("A1")
            End If
            Set sh = Nothing
 
            .Rows(i).Copy Sheets(s).Cells(Rows.Count, "A").End(xlUp)(2)
 
            i = i + 1
        Wend
    End With
 
End Sub
Что-то без переменной s не работало копирование... Ну и ладно, не вникал...
1
12 / 12 / 2
Регистрация: 27.11.2011
Сообщений: 652
10.05.2013, 19:12  [ТС] 5
Спасибо огромное!!! А не подскажите, через макрос можно в Главную добавить в колонку сколько им лет (напр. 25 лет 8 мес). Какие строчки надо написать??? Спасибо!!!!!
0
3183 / 938 / 216
Регистрация: 29.05.2010
Сообщений: 2,046
10.05.2013, 21:57 6
Добавить колонку конечно можно, считать возраст от текущей даты?
0
12 / 12 / 2
Регистрация: 27.11.2011
Сообщений: 652
10.05.2013, 22:07  [ТС] 7
да, от текущей!!!
0
призрак
3259 / 884 / 118
Регистрация: 11.05.2012
Сообщений: 1,702
Записей в блоге: 2
10.05.2013, 23:22 8
чё-то дежавю у меня какое-то...

timsc1, вот в этой вашей теме: Списки людей не должны повторяться мы разве не создавали подобный макрос?
0
12 / 12 / 2
Регистрация: 27.11.2011
Сообщений: 652
10.05.2013, 23:25  [ТС] 9
Это немного другая задачка. но её уже решили. А вот как вставить возраст каждого???
0
призрак
3259 / 884 / 118
Регистрация: 11.05.2012
Сообщений: 1,702
Записей в блоге: 2
10.05.2013, 23:31 10
Цитата Сообщение от timsc1 Посмотреть сообщение
немного другая задачка
именно, что немного.
и для каждого варианта, отличающегося одной колонкой или парой формул - новая тема?
и просить всё делать заново, даже не попытавшись применить известный код?

ну ладно.
другая - так другая.
0
12 / 12 / 2
Регистрация: 27.11.2011
Сообщений: 652
11.05.2013, 18:15  [ТС] 11
Определить, сколько им лет, напр. 25 лет 8 мес. Помогите пожалуйста. написал код на VBA, но не получается:
Visual Basic
1
2
3
4
If Month(Cells(2, 5)) < Month(Date) Then
Cells(2, 7) = DateDiff("yyyy", Cells(2, 5), Now) - 1 & "  " & DatePart("m", DateDiff("m", Range("e2"), Now))
Else: Cells(2, 7) = DateDiff("yyyy", Cells(2, 5), Now) & "  " & DatePart("m", DateDiff("m", Range("e2"), Now))
End If
И как вставить колонку в нужное место, напр. между колонками E и F????
Спасибо!!!
0
3183 / 938 / 216
Регистрация: 29.05.2010
Сообщений: 2,046
11.05.2013, 18:58 12
Если ввести формулу в ячейку то всегда будет оперативная информация о возрасте, иначе каждый раз перерасчет. И еще если возраст 25 то лет, а 31 то год, так может быть лучше выводить в формате "ГГ.ММ"?
0
12 / 12 / 2
Регистрация: 27.11.2011
Сообщений: 652
11.05.2013, 19:03  [ТС] 13
Перерасчёт не страшен, кнопку нажал и получил. Надо бы лет и мес. Год и лет можно потом доделать через IF. А пока как рассчитанность, не знаю. Столько часов с этим мучаюсь. Кошмар какой-то. Из-за еруды и завис...
0
3183 / 938 / 216
Регистрация: 29.05.2010
Сообщений: 2,046
11.05.2013, 19:34 14
Примерно так:
Visual Basic
1
2
3
4
5
6
7
8
9
Sub Vozrast()
    Dim c As Range
    'вставить колоку между E и F
    Columns("F:F").Insert Shift:=xlToRight
    Cells(1, 6) = "Возраст"
    For Each c In Range(Cells(2, 6), Cells(ActiveSheet.UsedRange.Rows.Count, 6))
        c = Format(Date - c.Offset(0, -1).Value, "yy ""лет"" m ""мес"";@")
    Next
End Sub
Что касается ЛЕТ или ГОД сам доделаешь.
1
12 / 12 / 2
Регистрация: 27.11.2011
Сообщений: 652
11.05.2013, 20:08  [ТС] 15
Спасибки, toiai, Дай Вам БОГ здоровья!!!
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
11.05.2013, 20:08

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

Скопировать выделенные листы в другую книгу
Здравствуйте, уважаемые формумчане! Мне необходимо макросом скопировать выделенные вразнобой листы...

Макрос. Скопировать листы с закрытой книги
Преприятие использует программу САП САП выгружает документы в папку FromSap с именем :&quot;...

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

Скопировать данные из sheet1 на другие листы этой же книги
Как макросам можно скопировать все данные из sheet1 в остальные скажем 5 sheet'ов


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
15
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.