Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Помогите удалить данные из одной таблицы в другой
 
#1
20.02.2021 20:16:21
Здравствуйте, есть проблема. Из одного списка нужно полностью удалить информацию другого списка. Из-за огромного количества ячеек сделать это вручную невозможно, а за счет неполноты названий из второй таблицы - Эксель дупликаты не видит, то есть просто удалить дупликаты не выйдет. Но в свою очередь в панели поиска совпадения он находит.
 
 
 
#2
20.02.2021 20:22:53
Цитата
Александр Малов написал:
Помогите удалить данные из одной таблицы в другой
хде таблцы? хде исходные данные? хде желаемый результат? что-нибудь?
и кто это?
Цитата
дупликаты
Изменено: Mershik - 20.02.2021 20:23:23
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
20.02.2021 20:27:44
из-за высокого размера исходную таблицу кинуть не смог, не знаю, что могу сделать
 
 
 
#4
20.02.2021 20:29:47
https://disk.yandex.ru/d/QF4yB-OsT_4RFg

Из этого файла нужно удалить информацию, которая лежит в этом файле:
 
 
 
#5
20.02.2021 20:29:55
Александр Малов,   никого не интересует Ваш оригинальный файл - нужен файл-пример - урежьте его максимально оставите 10-20 строк в таблицах и покажите желаемый результат.
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#6
20.02.2021 20:40:35
Меня интересует лишь то, как из файла А удалить информацию файла Б, при условии, что ни "поиск дупликатов", ни скрипты, не помогают. Приходится делать все через ручной поиск, но в условиях 5000+ позиций, сделать это невозможно :( .
Эксель находит информацию, при условии полного совпадение строк.  
 
 
 
#7
20.02.2021 20:59:57
Александр Малов, ну как-то так - предположим что у Вас в файле два листа один с названием Лист2ругой c БД.
в ЬД - данные в которых ищем изменяем
в Лист2 - данные в которых какие ищем
запускать с активным листом БД - не уверен что оно)
Код
Sub Макрос1()
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
x = Worksheets("Лист2").Range("A" & i)
    Cells.Replace What:=x, Replacement:="", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
        False, ReplaceFormat:=False

Next i
End Sub
Изменено: Mershik - 20.02.2021 21:00:09
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#8
20.02.2021 21:23:08
К сожалению не помогло, никакой реакции не произошло, может вписал неправильно...
 
 
 
#9
20.02.2021 23:07:12
Александр Малов, одна строка в .csv файле соответствует одной ячейке? Там в некоторых местах есть символ ";" и не понятно в вашем случае, разделитель это или нет?
 
 
 
#10
21.02.2021 05:41:53
Макрос выводящий строки на третий лист за исключением тех которые нужно удалить
Файл
Код
Sub ExtractExcludingList()

Dim initialDataRange As Range
Dim exclusionsDataRange As Range
Dim initialDataArray() As Variant
Dim exclusionsDataArray() As Variant
Dim rowsToPreserve() As Variant

With ThisWorkbook.Worksheets(2)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set initialDataRange = .Range(.Cells(1, 1), .Cells(lastRow, 1))
initialDataArray = initialDataRange.Value
End With

With ThisWorkbook.Worksheets(1)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set exclusionsDataRange = .Range(.Cells(2, 1), .Cells(lastRow, 1))
exclusionsDataArray = exclusionsDataRange.Value
End With

matchFlag = False
For i = LBound(initialDataArray) To UBound(initialDataArray)
For j = LBound(exclusionsDataArray) To UBound(exclusionsDataArray)
If InStr(initialDataArray(i, 1), exclusionsDataArray(j, 1)) > 0 Then
matchFlag = True
End If
Next j
If matchFlag = False Then
myCount = myCount + 1
ReDim Preserve rowsToPreserve(myCount - 1)
rowsToPreserve(myCount - 1) = i
End If
matchFlag = False

Next i

result = Application.Index(initialDataArray, Application.Transpose(rowsToPreserve), 1)

With ThisWorkbook.Worksheets(3)
Set pasteDataRange = .Range(.Cells(1, 1), .Cells(UBound(result), 1))
pasteDataRange.Value = result
End With

End Sub
 
 
 
#11
21.02.2021 10:34:23
Написал макрос удаляющий по другому Т е файл БД.csv  открывается в режиме прямого доступа считывается построчно сравнивается строка с искомыми и если нет совпадений записывается в новый файл. Но результат получается другой по сравнению с макросом в предыдущем сообщении.написанным wfreedom.
Оба файла должны быть в одной папке. код в файле "файлы отсеяные.xls"
Код
Sub FiltrTextFile() 'Удаление ненужных строк  в текст файле по условию
Dim Rng As Range, DF1 As Byte, DF2 As Byte, File$, strPois$, XX, Data, Tp1, bln As Boolean, sTime As Date
    File = "БД.csv": bln = True: sTime = Timer
File = ThisWorkbook.Path & "\" & File
Tp1 = ActiveSheet.Cells(1).CurrentRegion.Value
    DF1 = FreeFile: Open File For Input As #DF1
File = Replace(File, ".", "1."): DF2 = FreeFile: Open File For Output As #DF2
Do While Not EOF(DF1) 'Начало цикла
    Line Input #DF1, Data ' считывание файла построчно
        For Each XX In Tp1 ' Массив искомых значений
            strPois = CStr(XX) & "*" ' Строка поиска
            If Data Like strPois Then bln = False: Exit For ' Сравнение строк
        Next XX
If bln Then If EOF(DF1) Then Print #DF2, Data; Else Print #DF2, Data
    bln = True: Loop: Close
'MsgBox "Время работы макроса " & Format(Timer - sTime, "0.000") & " сек"
End Sub
Изменено: Евгений Смирнов - 22.02.2021 06:13:49
 
 
 
Страницы: 1
Наверх