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

Вход

Регистрация

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

 

= Мир MS Excel/Многоуровневая подстановка данных - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Многоуровневая подстановка данных
Korobkow Дата: Вторник, 30.09.2014, 12:20 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 43
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый день многоуважаемые ГУРУ!!!
Долго искал готовое решение для моего случая, но такого не нашлось увы. Поэтому я тут, и думаю Вам не составит труда решить мою задачку.
Суть вопроса:
Лист "Бригада" заполнен данными с листа "Сбор" (вручную) именно так данные должны ложиться на этот и другие листы при нажатии на кнопку "Заполнить". Имя листа =А1, А1 использоварь для поиска.
Лист "Сбор" как видно постоянно обновляется и дополняется поэтому кол-во строк его будет около 18 000.
Кол-во работников (листов) примерно 100 человек. Это все к тому, что бы не очень сильно утяжелять документ.
Можно рассмотреть также и иное решение задачи т.е. не через кнопку а например обновлением связей при раздельном размещении Работников и листа СБОР
К сообщению приложен файл: 7697022.xls (96.0 Kb)


Сообщение отредактировал Korobkow - Вторник, 30.09.2014, 12:35
 
Ответить
СообщениеДобрый день многоуважаемые ГУРУ!!!
Долго искал готовое решение для моего случая, но такого не нашлось увы. Поэтому я тут, и думаю Вам не составит труда решить мою задачку.
Суть вопроса:
Лист "Бригада" заполнен данными с листа "Сбор" (вручную) именно так данные должны ложиться на этот и другие листы при нажатии на кнопку "Заполнить". Имя листа =А1, А1 использоварь для поиска.
Лист "Сбор" как видно постоянно обновляется и дополняется поэтому кол-во строк его будет около 18 000.
Кол-во работников (листов) примерно 100 человек. Это все к тому, что бы не очень сильно утяжелять документ.
Можно рассмотреть также и иное решение задачи т.е. не через кнопку а например обновлением связей при раздельном размещении Работников и листа СБОР

Автор - Korobkow
Дата добавления - 30.09.2014 в 12:20
Korobkow Дата: Вторник, 30.09.2014, 14:16 | Сообщение № 2
Группа: Пользователи
Ранг: Новичок
Сообщений: 43
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Нужели задача не имеет решения?
 
Ответить
СообщениеНужели задача не имеет решения?

Автор - Korobkow
Дата добавления - 30.09.2014 в 14:16
Rioran Дата: Вторник, 30.09.2014, 14:45 | Сообщение № 3
Группа: Авторы
Ранг: Ветеран
Сообщений: 903
Репутация: 290 ±
Замечаний: 0% ±

Excel 2013
Korobkow, здравствуйте.

Любая задача имеет решение. Предлагаю вариант из вложения, рабочие кнопки на каждом листе. Что думаете?

[vba]
Код
Option Explicit
Option Compare Text

Sub Personal_Download()

Dim X As Long, A As Long, B As Long
Dim shtX As Worksheet

Set shtX = ThisWorkbook.Worksheets("Сбор")
A = 3

Application.ScreenUpdating = False
With ActiveSheet

B = .Cells(.Rows.Count, 1).End(xlUp).Row
If B > 2 Then .Range(.Cells(3, 1), .Cells(B, 15)).Value = ""

For X = 1 To shtX.Cells(shtX.Rows.Count, 1).End(xlUp).Row
     If shtX.Cells(X, 2).Value = .Name Then
         .Cells(A, 1).Value = shtX.Cells(X, 1).Value
         .Cells(A, 2).Value = "'" & shtX.Cells(X, 3).Value
         .Cells(A, 3).Value = shtX.Cells(X, 4).Value
         .Cells(A, 4).Value = "'" & shtX.Cells(X, 5).Value
         .Cells(A, 7).Value = shtX.Cells(X, 6).Value
         A = A + 1
     End If
Next X

End With
Application.ScreenUpdating = True

End Sub
[/vba]
К сообщению приложен файл: Excel_DB.xlsm (48.3 Kb)


Роман, Москва, voronov_rv@mail.ru
Яндекс-Деньги: 41001312674279


Сообщение отредактировал Rioran - Вторник, 30.09.2014, 14:45
 
Ответить
СообщениеKorobkow, здравствуйте.

Любая задача имеет решение. Предлагаю вариант из вложения, рабочие кнопки на каждом листе. Что думаете?

[vba]
Код
Option Explicit
Option Compare Text

Sub Personal_Download()

Dim X As Long, A As Long, B As Long
Dim shtX As Worksheet

Set shtX = ThisWorkbook.Worksheets("Сбор")
A = 3

Application.ScreenUpdating = False
With ActiveSheet

B = .Cells(.Rows.Count, 1).End(xlUp).Row
If B > 2 Then .Range(.Cells(3, 1), .Cells(B, 15)).Value = ""

For X = 1 To shtX.Cells(shtX.Rows.Count, 1).End(xlUp).Row
     If shtX.Cells(X, 2).Value = .Name Then
         .Cells(A, 1).Value = shtX.Cells(X, 1).Value
         .Cells(A, 2).Value = "'" & shtX.Cells(X, 3).Value
         .Cells(A, 3).Value = shtX.Cells(X, 4).Value
         .Cells(A, 4).Value = "'" & shtX.Cells(X, 5).Value
         .Cells(A, 7).Value = shtX.Cells(X, 6).Value
         A = A + 1
     End If
Next X

End With
Application.ScreenUpdating = True

End Sub
[/vba]

Автор - Rioran
Дата добавления - 30.09.2014 в 14:45
Korobkow Дата: Вторник, 30.09.2014, 15:19 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 43
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Как все просто hands я думал тут макрос на два листа :D
Огромное спасибо
 
Ответить
СообщениеКак все просто hands я думал тут макрос на два листа :D
Огромное спасибо

Автор - Korobkow
Дата добавления - 30.09.2014 в 15:19
Korobkow Дата: Вторник, 30.09.2014, 15:53 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 43
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Rioran, УПС рано я обрадовался!
макрос затрагивает все пространство с А по О столбец - чистит, это не допустимо. Нужно чтоб заполнялись только столбцы ABCDG в остальных стоят другие формулы
 
Ответить
СообщениеRioran, УПС рано я обрадовался!
макрос затрагивает все пространство с А по О столбец - чистит, это не допустимо. Нужно чтоб заполнялись только столбцы ABCDG в остальных стоят другие формулы

Автор - Korobkow
Дата добавления - 30.09.2014 в 15:53
Korobkow Дата: Вторник, 30.09.2014, 15:58 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 43
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Проблема гдето тут наверно
[vba]
Код

B = .Cells(.Rows.Count, 1).End(xlUp).Row
If B > 2 Then .Range(.Cells(3, 1), .Cells(B, 15)).Value = ""
[/vba]
 
Ответить
СообщениеПроблема гдето тут наверно
[vba]
Код

B = .Cells(.Rows.Count, 1).End(xlUp).Row
If B > 2 Then .Range(.Cells(3, 1), .Cells(B, 15)).Value = ""
[/vba]

Автор - Korobkow
Дата добавления - 30.09.2014 в 15:58
Korobkow Дата: Вторник, 30.09.2014, 16:31 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 43
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Тут он очищает все, анужно очистить только 1,2,3,4,7 столбец, и то только там где данные есть т.е. до первой пустой ячейки
типо както вот но чуть подругому - ограничить надо первой пустой
[vba]
Код

Range("A3:A21,B3:C21,C3:C21,D3:D21,G3:G21").Select
Selection.ClearContents
[/vba]
 
Ответить
СообщениеТут он очищает все, анужно очистить только 1,2,3,4,7 столбец, и то только там где данные есть т.е. до первой пустой ячейки
типо както вот но чуть подругому - ограничить надо первой пустой
[vba]
Код

Range("A3:A21,B3:C21,C3:C21,D3:D21,G3:G21").Select
Selection.ClearContents
[/vba]

Автор - Korobkow
Дата добавления - 30.09.2014 в 16:31
ShAM Дата: Вторник, 30.09.2014, 16:50 | Сообщение № 8
Группа: Друзья
Ранг: Старожил
Сообщений: 1347
Репутация: 249 ±
Замечаний: 0% ±

Excel 2010
Уважаемый Rioran уже нашел номер первой непустой строки - B. Тогда, может, так:
[vba]
Код
.Range("A3:D" & B & ",G3:G" & B).ClearContents
[/vba]
 
Ответить
СообщениеУважаемый Rioran уже нашел номер первой непустой строки - B. Тогда, может, так:
[vba]
Код
.Range("A3:D" & B & ",G3:G" & B).ClearContents
[/vba]

Автор - ShAM
Дата добавления - 30.09.2014 в 16:50
Rioran Дата: Вторник, 30.09.2014, 19:45 | Сообщение № 9
Группа: Авторы
Ранг: Ветеран
Сообщений: 903
Репутация: 290 ±
Замечаний: 0% ±

Excel 2013
ShAM, спасибо за комментарий. Интересное обращение к кусочно заданным интервалам, надо будет синтаксис запомнить =)

Korobkow, поддерживаю решение уважаемого ShAM'a, итоговый вид строки будет:

[vba]
Код
If B > 2 Then .Range("A3:D" & B & ",G3:G" & B).ClearContents
[/vba]
Где условие если спасёт нас от удаления заголовков при пустой таблице.


Роман, Москва, voronov_rv@mail.ru
Яндекс-Деньги: 41001312674279
 
Ответить
СообщениеShAM, спасибо за комментарий. Интересное обращение к кусочно заданным интервалам, надо будет синтаксис запомнить =)

Korobkow, поддерживаю решение уважаемого ShAM'a, итоговый вид строки будет:

[vba]
Код
If B > 2 Then .Range("A3:D" & B & ",G3:G" & B).ClearContents
[/vba]
Где условие если спасёт нас от удаления заголовков при пустой таблице.

Автор - Rioran
Дата добавления - 30.09.2014 в 19:45
Korobkow Дата: Среда, 01.10.2014, 21:18 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 43
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Очень спасибо все работает на 5.
 
Ответить
СообщениеОчень спасибо все работает на 5.

Автор - Korobkow
Дата добавления - 01.10.2014 в 21:18
  • Страница 1 из 1
  • 1
Поиск:

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