Помогите пожалуйста адаптировать макрос уважаемого Hugo. Необходимо с Лист2 перенести на Лист1 данные из столбцов Заявка3, Дата1 и Дата2, сопоставив данные из столбцов Заявка1. Понимание как работает макрос есть, но не хватает знаний по синтаксису для адаптации. Макрос из темы: https://www.planetaexcel.ru/forum/?FID=8&PAGE_NAME=read&TID=31763
Код
Option Explicit
Sub compare()
Dim a, b, c, iLastrow As Long, i As Long, ii As Long
'1. данные в два массива
With Sheet1 'используется кодовое имя
iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
a = Range(.[a3], .Range("A" & iLastrow)).Value
End With
With Sheet2 'используется кодовое имя
iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
b = Range(.[c2], .Range("A" & iLastrow)).Value
End With
'2.пустой массив для результата
ReDim c(1 To UBound(a), 1 To 2)
With CreateObject("Scripting.Dictionary")
'3.в словарь уникальные и номер строки из массива
For i = 1 To UBound(b)
.Item(b(i, 1)) = i
Next
'4.по словарю из массива b в массив c
For i = 1 To UBound(a)
If .exists(a(i, 1)) Then
c(i, 1) = b(.Item(a(i, 1)), 2)
c(i, 2) = b(.Item(a(i, 1)), 3)
End If
Next
End With
'5. выгрузка всего массива
With Sheet1 'используется кодовое имя
.[B3].Resize(UBound(c), 2) = c
.Activate
End With
End Sub
Спасибо, но с организовать через подстановку формулой проблем нет - это все очень медленно. В примере небольшая таблица,в реальности надо обработать таблицу больше 30 тыс. строк и и больше 200 столбцов. И делать это приходится каждый день и не раз.
Marat Ta написал: Переносить в ваш файл пример нет времени.
Спасибо! Адаптировал. Все работает с примером. Попробую "прикрутить" к рабочей таблице. Может быть еще подскажете как ускорить этот код преобразования текста в дату?
Код
Cnumb = Rows(1).Find("Контрольная дата", , xlValues, xlWhole).Column
Range(Cells(2, Cnumb), Cells(NumberLastRow1, Cnumb)).Select
Selection.NumberFormat = "dd/mm/yy h:mm;@"
On Error Resume Next
Set myRange = Intersect(Selection, ActiveSheet.UsedRange)
For Each cl In myRange
cl.Value = DateValue(cl.Value)
cl.Value = cl.Value + 0.333333333
Next
Marat Ta написал: Прикрепите новый файл пример с макросами.
Приложил. Ускорить наверно через обработку в массиве и после запись в диапазон?
Код
Sub DatVal()
NumberLastRow1 = Range("a1").CurrentRegion.Rows.Count
Range(Cells(2, 2), Cells(NumberLastRow1, 2)).Select
Selection.NumberFormat = "dd/mm/yy h:mm;@"
On Error Resume Next
Set myRange = Intersect(Selection, ActiveSheet.UsedRange)
For Each cl In myRange
cl.Value = DateValue(cl.Value)
cl.Value = cl.Value + 0.333333333
Next
End Sub
Карабас: Может быть еще подскажете как ускорить этот код преобразования текста в дату?
а может быть вообще не будем новые темы создавать и все вопросы скидывать сюда, а?
Цитата
Marat Ta: Прикрепите новый файл пример с макросами
вам мало по шапке наприлетало от модераторов? Зачем провоцируете нарушения?
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Марат, без обид, хотелось бы увидеть Ваши ответы здесь (на одном или на разных) и здесь (форматирование). Тема без окончательного вывода осталась... Причина в форматировании была или в варианте версии 2010? Подобные проблемы и у других возникнуть могут, а конкретного ответа (помогло или нет и в чем была причина) в той теме так и нет...