Сравнивание названий в ячейках Exel и перенос несовпавших вниз
Вложений: 1
Приветствую всех знающих! Нужна Ваша помощь, нужен скрипт, который сделает следущие вещи, следствие этого – намного упростятся дальнейшие задачи. Премного благодарен заранее! Итак, по порядку:
Есть файл example.xls в котором пять вкладок: Исходный файл_1, Выходной файл_1, Исходный файл_2, Выходной файл_2,Итоговый файл. Исходный файл_1 – есть две колонки (обозначенные разным цветом для понятия задачи), столбцы B и F содержат названия. Нужно каждое название из столбца F сравнить с названиями из столбца B, и если названия совпадает, то из ячейки этой же строчки, но соседнего столбца E копируем значение в столбец A возле совпадающего названия и оставляем запись на месте, если названия не совпадает, тогда вся строка, начиная со столбца E копируется вниз поочередно, ниже уровня условно разделенных двух колонок(той, в которой больше позицый), под первой колонкой. Выходной файл_1 – то что должны получить после работы скрипта. Сиреневатые ячейки столбца А – скопированные из соседних ячеек совпавших названий(столбца Е). Голубой столбец остался неизменен. Сиреневые строки – это те, что совпали, и зеленоватые – те что не совпали, их вырезали и вставили внизи поочередно. Исходный файл_2, Выходной файл_2 – смысл тот же, только иные столбцы, а также при переносе несовпадающих сторочек значения из столбца N переносятся в столбец А. Исходник в Итоговом файле(с ним ничего не нужно делать, он как пример, того что должно получиться). По сути дела нужны два сходных скрипта с различными параметрами, или один универсальный. Всех, кому не составит большого труда помочь в этом вопросе, помогите, плиз! |
Вложений: 1
Нашел похожее решение, но здесь выбирается то, что есть в столбце, а нужно то чего нету. Может кто знает, подскажите, плиз, что поменять в коде
Sub test() On Error Resume Next: Application.ScreenUpdating = False Dim sh2 As Worksheet: Set sh2 = Worksheets(2) sh2.UsedRange.Clear ' очистка листа от прежних данных Dim cell As Range, ra As Range, ForCopy As Range ' перебираем все заполненные ячейки в столбце Е Set ra = Range([e1], Range("e" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants) For Each cell In ra.Cells If Not Range("a:a").Find(cell) Is Nothing Then ' если аналогичный номер есть в столбце А If ForCopy Is Nothing Then Set ForCopy = cell Else Set ForCopy = Union(ForCopy, cell) If ForCopy.Cells.Count > 1000 Then ForCopy.EntireRow.Copy sh2.Range("a" & sh2.Rows.Count).End(xlUp).Offset(1) Set ForCopy = Nothing End If End If Next cell ForCopy.EntireRow.Copy sh2.Range("a" & sh2.Rows.Count).End(xlUp).Offset(1) sh2.UsedRange.EntireColumn.AutoFit: sh2.Rows(1).Delete sh2.Activate |
Время: 06:05. |
Время: 06:05.
© OSzone.net 2001-