Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Выборка из таблицы и запись данных по условиям - VBA
 
#1
08.02.2018 12:18:33
Всем привет, ситуация такова:
Есть таблица на листе1 с датой, именем и городом. Есть вторая "таблица" на листе 2 в которой столбцы подписанные как все существующие города в таблице на листе 1.
На листе2 так же есть поля для ввода начальной даты и конечной даты. (сейчас там указан весь диапазон).

Вопрос как проще всего макросом перекинуть данные с столбца Name в соответствующий столбец города на листе 2 учитываю диапазон дат.
Например выбрав только 01.01.2018 по 01.02.2018 что бы закинулись только данные которые есть в этот период на листе1.

P.S. знаю как сделать формулой, но формула не пойдет, файл делается полностью без формул. Да и формула массива при большом объеме данных повесит файл...

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

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

P.S. писал уже на нескольких форумах, за 3 дня ни одного ответа. Может хоть тут есть добрые люди АСЫ vba.
Изменено: Lucifer - 25.05.2018 18:30:22
 
 
 
#2
08.02.2018 13:56:20
Lucifer, нужно набраться терпения)  просто не все так же как и Вы умеют писать макросы)
Изменено: a.i.mershik - 08.02.2018 13:57:25
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
08.02.2018 14:01:09
Лично я не понял задачу.
на втором листе как должно получиться? если нет то ручками набросайте.
 
 
 
#4
08.02.2018 14:02:02
V, да судя по 2 листу нужно что бы вывелся список городов и под каждым городом был список ФИО.
ну формулами кстати быстро можно)
Изменено: a.i.mershik - 08.02.2018 14:05:30
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
08.02.2018 14:05:40
a.i.mershik, а даты здесь причем?
 
 
 
#6
08.02.2018 14:12:00
V, ну полагаю что за определенный период с такой даты по такую которые есть на 1 листе....
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#7
08.02.2018 14:33:42
Доброе время суток.
Версия на Power Query.
Успехов.
 
 
 
#8
08.02.2018 14:43:51
Цитата
V написал: на втором листе как должно получиться?
да
Цитата
a.i.mershik написал: ну формулами кстати быстро можно)
формулами можно, но нужно именно макрос который потом будет привязан к кнопке для формирования этого списка. Потом таблица будет очищаться,
формул не должно быть в файле вообще.
Я формулами делал не удобно....(((
Цитата
a.i.mershik написал: ну полагаю что за определенный период с такой даты по такую которые есть на 1 листе....
да, все правильно Вы поняли :)
Цитата
Андрей VG написал: Доброе время суток.Версия на Power Query.Успехов.
спасибо большое Ваша версия то что нужно, а реально ли это перевести как то на макрос? что бы не было запросов
 
 
 
#9
08.02.2018 14:53:39
По поводу макроса, кажется нашел решение, позже выложу что бы могли другие использовать!  
 
 
 
#10
08.02.2018 14:58:25
Цитата
Lucifer написал:
реально ли это перевести как то на макрос?
Без сомнения. Загрузить с фильтрацией по датам данные в словарь коллекций. Затем переписать в массив с числом строк по максимуму значений из коллекций + 1 на заголовок, числом столбцов - число ключей словаря.
 
 
 
#11
08.02.2018 15:09:22
с моими знаниями vba такое навоял.
Код
Sub vvv()
Dim ndata As Date, kdata As Date
Dim i%, j%, n
ndata = Sheets("Лист2").Range("A1")
kdata = Sheets("Лист2").Range("B1")
m = Sheets("Лист1").Range("A1").CurrentRegion.Value
Set sd = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(m)
    If m(i, 2) >= ndata And m(i, 2) <= kdata Then
       If sd.Item(m(i, 5)) = "" Then
          sd.Item(m(i, 5)) = m(i, 4)
       Else
          sd.Item(m(i, 5)) = sd.Item(m(i, 5)) & "/" & m(i, 4)
       End If
    End If
Next
With Sheets("Лист2")
.Range("A10").Resize(1, sd.Count) = sd.keys
  For Each n In sd.Items
  j = j + 1
     mv = Split(n, "/")
     If UBound(mv) = 0 Then
       .Cells(11, j) = mv
     Else
       .Cells(11, j).Resize(UBound(mv) + 1) = Application.Transpose(mv)
     End If
   Next
End With
End Sub
 
 
 
#12
25.05.2018 14:59:03
V,благодарю, Ваш код очень кстати!  
 
 
 
Страницы: 1
Читают тему
Наверх