Здравствуйте, уважаемые форумчане. Суть проблемы: помогите пожалуйста написать макрос. Суть его такова: Есть к примеру два столбца: в первом не обрезанные строки, во втором обрезанные (имеется ввиду текст в ячейке), но они на разных позициях. Строки во втором столбце должны оставаться на своих местах. Т.е. выбираем первую строку первого столбца, копируем 30 знаков (к примеру) начиная с 7 от начала (можно и без этого, но желательно), ищем во втором столбце совпадение - если нашло, то копируем эту строку с первого столбца, туда, где было найдено совпадение во второй. И помечаем в обоих столбцах желтым цветом. Если совпадение найдено не было то красным, и переходим к след. И так по циклу до последней строки первого столбца. Это очень сложно? В прикрепленном файле небольшой пример.... просто таких строк более 10 000 - в ручную это не реал, в те сроки которые у меня. Буду оооочень благодарен за помощь.
Здравствуйте, уважаемые форумчане. Суть проблемы: помогите пожалуйста написать макрос. Суть его такова: Есть к примеру два столбца: в первом не обрезанные строки, во втором обрезанные (имеется ввиду текст в ячейке), но они на разных позициях. Строки во втором столбце должны оставаться на своих местах. Т.е. выбираем первую строку первого столбца, копируем 30 знаков (к примеру) начиная с 7 от начала (можно и без этого, но желательно), ищем во втором столбце совпадение - если нашло, то копируем эту строку с первого столбца, туда, где было найдено совпадение во второй. И помечаем в обоих столбцах желтым цветом. Если совпадение найдено не было то красным, и переходим к след. И так по циклу до последней строки первого столбца. Это очень сложно? В прикрепленном файле небольшой пример.... просто таких строк более 10 000 - в ручную это не реал, в те сроки которые у меня. Буду оооочень благодарен за помощь.iGenex
Sub www() Dim rez(), arr, arr1, i&, j& arr = Range([D2], Range("D" & Rows.Count).End(xlUp)).Value arr1 = Range([I2], Range("I" & Rows.Count).End(xlUp)).Value ReDim rez(1 To UBound(arr), 1 To 1) With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 1 To UBound(arr) For j = 1 To UBound(arr1) If Mid(arr(i, 1), 7, 30) = Mid(arr1(j, 1), 7, 30) Then rez(j, 1) = arr(i, 1) End If Next j Next i End With [H2:H65536].Clear [H2].Resize(UBound(arr)).Value = rez End Sub
[/vba] или не допонял???
красить не будет, но сверяет [vba]
Code
Sub www() Dim rez(), arr, arr1, i&, j& arr = Range([D2], Range("D" & Rows.Count).End(xlUp)).Value arr1 = Range([I2], Range("I" & Rows.Count).End(xlUp)).Value ReDim rez(1 To UBound(arr), 1 To 1) With CreateObject("Scripting.Dictionary") .CompareMode = 1 For i = 1 To UBound(arr) For j = 1 To UBound(arr1) If Mid(arr(i, 1), 7, 30) = Mid(arr1(j, 1), 7, 30) Then rez(j, 1) = arr(i, 1) End If Next j Next i End With [H2:H65536].Clear [H2].Resize(UBound(arr)).Value = rez End Sub
Словарь круто Не вполне понятно, когда начинаешь вникать - а если в первом файле 10 строк с одинаковым началом? А если у них разное продолжение? А вообще конечно словарь можно использовать
Словарь круто Не вполне понятно, когда начинаешь вникать - а если в первом файле 10 строк с одинаковым началом? А если у них разное продолжение? А вообще конечно словарь можно использовать Hugo
Sub www() Dim rez(), arr, arr1, i&, j& arr = Range([D2], Range("D" & Rows.Count).End(xlUp)).Value arr1 = Range([I2], Range("I" & Rows.Count).End(xlUp)).Value ReDim rez(1 To UBound(arr), 1 To 1) With CreateObject("Scripting.Dictionary") For i = 1 To UBound(arr) .Item(Mid(arr(i, 1), 7, 30)) = i Next
For i = 1 To UBound(arr1) If .exists(Mid(arr1(i, 1), 7, 30)) Then rez(i, 1) = arr(.Item(Mid(arr1(i, 1), 7, 30)), 1) End If Next
End With [H2:H65536].Clear [H2].Resize(UBound(arr)).Value = rez End Sub
[/vba]
учусь [vba]
Code
Sub www() Dim rez(), arr, arr1, i&, j& arr = Range([D2], Range("D" & Rows.Count).End(xlUp)).Value arr1 = Range([I2], Range("I" & Rows.Count).End(xlUp)).Value ReDim rez(1 To UBound(arr), 1 To 1) With CreateObject("Scripting.Dictionary") For i = 1 To UBound(arr) .Item(Mid(arr(i, 1), 7, 30)) = i Next
For i = 1 To UBound(arr1) If .exists(Mid(arr1(i, 1), 7, 30)) Then rez(i, 1) = arr(.Item(Mid(arr1(i, 1), 7, 30)), 1) End If Next
End With [H2:H65536].Clear [H2].Resize(UBound(arr)).Value = rez End Sub
Sub www() Dim rez(), arr, arr1, i&, tmp arr = Range([D2], Range("D" & Rows.Count).End(xlUp)).Value arr1 = Range([I2], Range("I" & Rows.Count).End(xlUp)).Value ReDim rez(1 To UBound(arr), 1 To 1) With CreateObject("Scripting.Dictionary") For i = 1 To UBound(arr) tmp = Mid(arr(i, 1), 7, 30) .Item(tmp) = i Next For i = 1 To UBound(arr1) tmp = Mid(arr1(i, 1), 7, 30) If .exists(tmp) Then rez(i, 1) = arr(.Item(tmp), 1) End If Next End With [H2:H65536].Clear [H2].Resize(UBound(arr)).Value = rez End Sub
[/vba]
и на 2003 ругается на строку [H2].Resize(UBound(arr)).Value = rez на 2010 работает
что-то без rez не получается у меня
[vba]
Code
Sub www() Dim rez(), arr, arr1, i&, tmp arr = Range([D2], Range("D" & Rows.Count).End(xlUp)).Value arr1 = Range([I2], Range("I" & Rows.Count).End(xlUp)).Value ReDim rez(1 To UBound(arr), 1 To 1) With CreateObject("Scripting.Dictionary") For i = 1 To UBound(arr) tmp = Mid(arr(i, 1), 7, 30) .Item(tmp) = i Next For i = 1 To UBound(arr1) tmp = Mid(arr1(i, 1), 7, 30) If .exists(tmp) Then rez(i, 1) = arr(.Item(tmp), 1) End If Next End With [H2:H65536].Clear [H2].Resize(UBound(arr)).Value = rez End Sub
[/vba]
и на 2003 ругается на строку [H2].Resize(UBound(arr)).Value = rez на 2010 работаетABC
MS Excel 2007 and 2010... ------------------------------- С Уважением, Даулет
Сообщение отредактировал ABC - Суббота, 08.09.2012, 21:27
Первый раз tmp ускорения не даст, лишнее. Такой вариант кода ABC:
[vba]
Code
Sub www() Dim arr, arr1, i&, tmp arr = Range([D2], Range("D" & Rows.Count).End(xlUp)).Value arr1 = Range([I2], Range("I" & Rows.Count).End(xlUp)).Value With CreateObject("Scripting.Dictionary") For i = 1 To UBound(arr) .Item(Mid(arr(i, 1), 7, 30)) = i Next For i = 1 To UBound(arr1) tmp = Mid(arr1(i, 1), 7, 30) If .exists(tmp) Then arr1(i, 1) = arr(.Item(tmp), 1) End If Next End With Range("H2:H" & UBound(arr1) + 1).Clear [H2].Resize(UBound(arr1), 1).Value = arr1 End Sub
[/vba]
Первый раз tmp ускорения не даст, лишнее. Такой вариант кода ABC:
[vba]
Code
Sub www() Dim arr, arr1, i&, tmp arr = Range([D2], Range("D" & Rows.Count).End(xlUp)).Value arr1 = Range([I2], Range("I" & Rows.Count).End(xlUp)).Value With CreateObject("Scripting.Dictionary") For i = 1 To UBound(arr) .Item(Mid(arr(i, 1), 7, 30)) = i Next For i = 1 To UBound(arr1) tmp = Mid(arr1(i, 1), 7, 30) If .exists(tmp) Then arr1(i, 1) = arr(.Item(tmp), 1) End If Next End With Range("H2:H" & UBound(arr1) + 1).Clear [H2].Resize(UBound(arr1), 1).Value = arr1 End Sub
Что за глупый вопрос? Ты из дома выходишь без словаря? )
Quote (Hugo)
Словарь круто Не вполне понятно, когда начинаешь вникать - а если в первом файле 10 строк с одинаковым началом? А если у них разное продолжение? А вообще конечно словарь можно использовать
еще бы Hugo сказал по другому
Quote (Hugo)
Вот тут
Quote (Hugo)
я бы добавил переменную для скорости:
правильно! Чтобы выхлоп был больше )))
А, вообще, я код и задачу не смотрел. Пришел поржать, а то совсем грустно...
p.s.: предлагаю от arr и arr1 перейти к data и result
Quote (ikki)
ABC, а словарь зачем?
Что за глупый вопрос? Ты из дома выходишь без словаря? )
Quote (Hugo)
Словарь круто Не вполне понятно, когда начинаешь вникать - а если в первом файле 10 строк с одинаковым началом? А если у них разное продолжение? А вообще конечно словарь можно использовать
еще бы Hugo сказал по другому
Quote (Hugo)
Вот тут
Quote (Hugo)
я бы добавил переменную для скорости:
правильно! Чтобы выхлоп был больше )))
А, вообще, я код и задачу не смотрел. Пришел поржать, а то совсем грустно...
p.s.: предлагаю от arr и arr1 перейти к data и resultnerv
Чебурашка стал символом олимпийских игр. А чего достиг ты? Тишина - самый громкий звук
помогите пожалуйста. у меня таблицы на 2х листах. работать нужно только с 3мя столбцами. с одним столбцом на одном листе и с 2мя на другом. на первом листе слобец с номерами, на втором столбец с теми же номерами и столбец с зарплатой. надо написать цикл что бы он сверял номера и если номера одинаковые он проверял зарплату
помогите пожалуйста. у меня таблицы на 2х листах. работать нужно только с 3мя столбцами. с одним столбцом на одном листе и с 2мя на другом. на первом листе слобец с номерами, на втором столбец с теми же номерами и столбец с зарплатой. надо написать цикл что бы он сверял номера и если номера одинаковые он проверял зарплатуГость
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
