Макрос для выборочного переноса данных между листами Excel

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

terminator
Сообщения: 18
Зарегистрирован: 11 дек 2004, 21:09
Откуда: Москва

11 дек 2004, 21:55

Я пролистал несколько листов назад и судя по вашим коментариям вы хорошо разбираетесь в VB. Поэтому сразу к моей проблеме. -
очень бы хотелось сделать разнос значений из столбца А в столбцы А на других листах в зависимости от имени листа.
ПРИМЕР: Есть большое количество листов - Маша , Коля, Дима, и т.д.
и один лист по имени ОБЩИЙ. В ОБЩИЙ в ячейку "А 1"(число) вводится значение "100", в ячейку "В 1"(имя) имя человека "Маша". в ячейку "А 2" вводится число "200", в ячейку "В 2" имя человека "Дима". и т.д.
ВОПРОС: Каким образом можно разнести числа "100" , "200" , на листы "Маша", "Дима" и т.д по критерию указанному в соседнем столбце "В" (имя).
Есть хорошая мегафориула массива которая это делает, но если листов много и записей более 1000 то перещет на листе совершается очень долго. Если когото заинтересовала эта возможность вышлю готовое приложение на котором я работал без использования VBA.
Но с большим объёмом данных и последующим разносом на листы оно не справляется.
:wink: С уважением Евгений. :lol:
terminator
Сообщения: 18
Зарегистрирован: 11 дек 2004, 21:09
Откуда: Москва

12 дек 2004, 04:14

Начало крнечно простое
Dim A As Long
A = Application.WorksheetFunction.CountA(Sheets("ИмяЛиста").Range("B:B"))
With Sheets("ИмяЛиста")
.Cells(A + 1, 2) = TextBoxНазвание1
.Cells(A + 1, 3) = TextBoxНазвание2
при условии ввода через фориу , или из листа
Dim A As Long
A = Application.WorksheetFunction.CountA(Sheets("ИмяЛиста").Range("A:A"))
With Sheets("ИмяЛиста")
.Cells(A + 1, 1) = Sheets("ОБЩИЙ").Range("Адрес")
.Cells(A + 1, 2) = Sheets("ОБЩИЙ").Range("Адрес2")
Но как быть с выбором определённого листа? Без его активации.Тем более если значения указываются не в форме а в ячейках по мере их заполнения.? :roll:
Дмит
Сообщения: 144
Зарегистрирован: 27 ноя 2004, 22:23
Контактная информация:

13 дек 2004, 19:07

А если просто сделать циклы в которых одна строка:
Worksheets(Cells(i, 2).Value).Cells(StrokaWstawki, 1).Value = Cells(i, 1).Value

Дмит
terminator
Сообщения: 18
Зарегистрирован: 11 дек 2004, 21:09
Откуда: Москва

13 дек 2004, 23:12

Зациклить? :?: Хорошо. Но каким образом будет производиться выбор именно записи "100" изходя из того, что в сосодней ячейке справа есть надпись например"Дима", и помещаться на лист с именем "Дима"? Причём очерёдность не известна и количество повторов тоже. Сдесь наверное нужен циклический метод проверки, но то что я пытался написать даже приводить не буду, слижком громозко и в конце концов, рано или боздно некоректно выполняет выбор. Хотя я уверен это очень просто. Я видел перу подобных кодов. :roll: Они делают невообразимай перебор и поиск , очень компактны и шустро работают.
:shock: Кодеры по Бейсмку выручайте !!! :shock:
I'm back !
uhm57
Сообщения: 5
Зарегистрирован: 09 дек 2004, 10:46

14 дек 2004, 11:02

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

Код: Выделить всё

    For i = 1 To Range("A1").SpecialCells(xlLastCell).Row
        Sheets(Cells(i, 2).Value).Cells(Sheets(Cells(i, 2).Value).Range("A1").SpecialCells(xlLastCell).Row + 1, 1) = Cells(i, 1).Value
    Next i
Комментарий:
Range("A1").SpecialCells(xlLastCell).Row возвращает номер строки последней непустой ячейки на листе. Внутреняя строка цикла берет номер строки последней непустой ячейки из листа, имя которого указано в столбце B на листе "общий", добавляет единицу, и в эту строку записывает значение из столбца A на листе "общий".

Надеюсь, так будет понятно.

Да, и еще - то, что я написал, не делает проверку существования листа с таким именем (т. е. если на листе "Общий" в стоблце B будет записано имя несуществующего листа, будет ошибка.
terminator
Сообщения: 18
Зарегистрирован: 11 дек 2004, 21:09
Откуда: Москва

14 дек 2004, 22:10

Очень рад что не отмахнулись от меня рукой и не забыли сделать пояснение.!
Уважаемый uhm57 и находчивый Дмит ! Спасибо.!
Однако. Проблема остаётся.... Сделать проверку на пустоту листа или определить последную не пустую ячейку и затем вставить туда значение - это я могу.Проверка существования листа с определённым именем , или создание листов строго в с соответствии с именами указанными в каком-либо месте, это я тоже могу. Но я никак не могу сделать КОРРЕКТНЫЙ перенос данных!
Вы всё мне правельно советуете, но может мне стоит уточнить следующее. Каждый день в столбец А вносится цыфра "100", в столбец В левее имя "Дима". И тут необходимо перенести запись на другой лист с именем "Дима".Через час, может быть внесено десять таких записей. Корректно это значить -
1) Перенос осуществляется только на названный Лист (Это я могу)
2) Перенос осуществляется последовательно в следующую не пустую.(Это я могу)
3) Перенос осуществляется только по команде. (Это совсем просто)
4) При переносе, сколько бы раз не повторялась команда(например нажатие на кнопку) данные не должны ещё раз вносится или каким-либо образом смешиваться(Это я тоже могу)
ОДНАКО,! Моя головная боль в том что я не в состоянии объеденить это свё вместе, всегда что-то происходит не до конца или не точно.
Я конечно руки не опускаю , сейчас попробую ещё раз что-то написать...
>> uhm57 . всё работает но делает ПОВТОР.! Ведь ВСЁ зациклено.
:shock: HELP! :shock:
I'm back !
terminator
Сообщения: 18
Зарегистрирован: 11 дек 2004, 21:09
Откуда: Москва

18 дек 2004, 19:40

Я разместил файл для всеобшего просмотра. Это маленький вырезанный кусок из большой программы. Если кто-то работает над чем либо подобным буду рад общению. Файл для просмотра и скачивания (Эксель) доступен по адресу:
webfile.ru/128304
в течение 7 дней до 19:31 25.12.2004.
I'm back !
Дмит
Сообщения: 144
Зарегистрирован: 27 ноя 2004, 22:23
Контактная информация:

19 дек 2004, 00:14

Посмотри http://dimit.pochta.ru/excel/primer.zip

Дмит
terminator
Сообщения: 18
Зарегистрирован: 11 дек 2004, 21:09
Откуда: Москва

19 дек 2004, 22:54

Спасибо за участие.!
Однако . Если я ввёл данные , нажал кнопку OK, данные ввелись корректно. Далее я нажимаю разнести , и всё происходит просто чудестно.! Но что же делать на следующий день, когда вновь требуется ввести новые данные, ПОСЛЕ НАЖАТИЯ КНОПКИ "РАЗНЕСТИ", ДАННЫЕ С ЛИСТА "ОБЩИЙ" ДУБЛИРУЮТСЯ НА ДРУГИЕ ЛИСТЫ ,НЕ ЗАВИСИМО ОТ ТОГО СКОЛЬКО ИХ НА САМОМ ДЕЛЕ. То есть происходит ошибка.! На листе "Общий" для имени "Андрей" , допустим три записи , а на листе"Андрей", через 3 дня будет 6 записей.! Это как раз то о чём я говорил в предыдушем посте.
Посмотри Дмит , ведь если мы вводим данные через форму, после нажатия "OK", они ведь не вносятся каждый раз. Я тебя понимаю, что ты скажешь , что это очень просто - очистил форму и всё. Да в том-то и дело , что с формой всё просто. А как бы вот чтобы после нажатия кнопки "разнести" данные не переносились в "слепую." Т.е. не повторялась одна и та же информация.
Я уж сомневаться начал, понимаешь ли ты меня, может я как-то слишком заумно это объясняю.
Что-то мне начинает кажется , что это неразрешимая задача. Наверное единственное решение это написать код для формы. Пусть она сама разносит. Разнос непосредственно с листа БЕЗ ДУБЛИРОВАНИЯ И ПОВТОРОВ, мне начинает казаться волшебством.
Как напишу код для формы , так сразу выложу для критики.
Спасибо.
I'm back !
uhm57
Сообщения: 5
Зарегистрирован: 09 дек 2004, 10:46

20 дек 2004, 11:42

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

Еще можно сделать так (хотя это очень неэффективный способ) - каждый раз перед работой макроса стирать все листы, кроме Общего, и заново обрабатывать весь список.
Ответить