[VBA] Перенос дубликатов строк

jared

Новый пользователь
Сообщения
5
Реакции
0
Добрый день, нужен скрипт для работы с дублями, нужно чтобы находил и копировал в новую книгу или лист. Формат файла:
 

Вложения

  • equipment.xlsx
    10.3 KB · Просмотры: 2
Здравствуйте!
Добро пожаловать на SafeZone.

Критерии для дубля какие?
 
Спасибо большое! Да критерий один найти строку с одинаковым s/n и скопировать в новый лист(все совпавшие строки). Иногда забивают один и тот же товар разными числами. Заранее спасибо.

Простите строки с одинаковым s/n.
 
Последнее редактирование модератором:
VB.NET / VBA:
Option Explicit

Public Sub main()
    Dim Sh1 As Worksheet, Sh2 As Worksheet
    Dim y As Long, x As Long, y2 As Long
    Dim s As String
    
    'дубликаты
    Set Sh1 = ThisWorkbook.Worksheets("Лист1")
    x = Sh1.Columns("G").Column
    
    'цель
    Set Sh2 = ThisWorkbook.Worksheets("Лист2")
    y2 = 2
    
    Application.ScreenUpdating = False
    
    Dim oDict As Object
    Set oDict = CreateObject("Scripting.Dictionary")
    
    For y = 2 To Sh1.Cells(Sh1.Rows.Count, 1).End(xlUp).Row
        s = Sh1.Cells(y, x)
        
        If Not oDict.Exists(s) Then
            oDict.Add s, y
        Else
            Sh1.Rows(y).Copy Sh2.Cells(y2, 1)
            y2 = y2 + 1
        End If
    Next
    
    Application.ScreenUpdating = True
    Set oDict = Nothing
End Sub
 
---------------------------

Windows Script Host

---------------------------

Сценарий:

Строка: 6

Символ: 13

Ошибка: Предполагается наличие окончания инструкции

Код: 800A0401

Источник: Ошибка компиляции Microsoft VBScript
 
Это не для VBScript, это макрос.
 

Вложения

  • Duplicates.xls
    41 KB · Просмотры: 2
Назад
Сверху Снизу