Страницы: 1 2 След.
RSS
перенос обновленной информации в соседний лист по уникальному номеру
 
Здравствуйте, помогите, пожалуйста, с макросом, либо формулой (чтобы не сильно утяжеляло исходный файл).

Что дано: исходный лист - "рабочий реестр", его необходимо обновлять по "выгрузке из базы". В которой каждый день появляются новые заявки (со всеми дополнительными данными - порядка 60 столбцов. Наименование столбцов в обоих реестрах идентичное.

Так вот, нужен такой макрос, который найдет уникальный номер заявки, скопирует ее в "рабочий реестр", а затем подтянет остальную информацию по этой заявке. А в конце еще и подсветит результат.Чтобы визуально видеть границу обновленного реестра.
 
По какой причине, сначала копируется уникальный номер заявки и только потом подтягивается информация. Почему бы сразу не копировать всю строку, тем более что
Цитата
Светлана написал:
Наименование столбцов в обоих реестрах идентичное.
?
А что вы пытались сделать по вашей проблеме? Может какие наработки есть?
Изменено: Nordheim - 12.12.2019 15:17:38
"Все гениальное просто, а все простое гениально!!!"
 
до этого пользовалась ВПР. расположение идентичных по наименованию столбцов не соблюдено. вся информация завязана на уникальном номере заявки
 
В выгрузке не могут встретиться уже существующие в реестре номера заявки?
"Все гениальное просто, а все простое гениально!!!"
 
Код
Sub Копирование_новых_заявок()
    Dim sh1 As Worksheet: Set sh1 = Worksheets("выгрузка из базы")
    Dim sh2 As Worksheet: Set sh2 = Worksheets("Рабочий реестр")
    
    Dim y1 As Long
    Dim y2 As Long
    
    With sh1
        y1 = .Cells(.Rows.Count, 3).End(xlUp).Row
        Dim a As Variant
        a = .Range(.Cells(1, 3), .Cells(y1, 3))
    End With
    
    With sh2
        y2 = .Cells(.Rows.Count, 3).End(xlUp).Row
    End With
    
    For y1 = 3 To UBound(a, 1)
        If a(y1, 1) <> "" Then
            If WorksheetFunction.CountIfs(sh2.Columns(3), a(y1, 1)) = 0 Then
                sh1.Rows(y1).Copy sh2.Rows(y2)
                sh2.Rows(y2).Interior.Color = RGB(200, 255, 200)
                y2 = y2 + 1
            End If
        End If
    Next
End Sub

 
Цитата
Nordheim написал:
В выгрузке не могут встретиться уже существующие в реестре номера заявки?
могут
 
большое спасибо! сейчас попробую
 
Скрытый текст
Изменено: Nordheim - 12.12.2019 15:54:23
"Все гениальное просто, а все простое гениально!!!"
 
Цитата
Светлана написал:
могут
И как в этом случае поступать? перезаписывать или оставлять все как есть?
"Все гениальное просто, а все простое гениально!!!"
 
Копирую код на свой рабочий файл с соблюдением номера столбца, в котором будет прописан номер заявки. В лист "рабочий реестр" переносятся все новые заявки, однако информация по столбцам перепутана, видимо код не сопоставляет заголовок столбца из 2 реестров.только номер заявки четко встает в 3 столбец. Как возможно изменить код?  
 
Код
Sub Копирование_новых_заявок_с_перестановкой_столбцов()
    Dim sh1 As Worksheet: Set sh1 = Worksheets("выгрузка из базы")
    Dim sh2 As Worksheet: Set sh2 = Worksheets("Рабочий реестр")
     
    Dim y1 As Long
    Dim y2 As Long
    Dim x1 As Integer
    Dim x2 As Integer
     
    With sh1
        y1 = .Cells(.Rows.Count, 3).End(xlUp).Row
        x1 = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Dim a As Variant
        Dim b As Variant
        a = .Range(.Cells(1, 1), .Cells(y1, x1))
        ReDim b(1 To 1, 1 To x1)
    End With
     
    With sh2
        y2 = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
    End With
     
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    For x1 = 1 To UBound(a, 2)
        If WorksheetFunction.CountIfs(sh2.Rows(1), a(1, x1)) > 0 Then
            dic(x1) = WorksheetFunction.Match(a(1, x1), sh2.Rows(1), 0)
        End If
    Next
     
    For y1 = 3 To UBound(a, 1)
        If a(y1, 3) <> "" Then
            If WorksheetFunction.CountIfs(sh2.Columns(3), a(y1, 3)) = 0 Then
                'sh1.Rows(y1).Copy sh2.Rows(y2)
                For x1 = 1 To UBound(a, 2)
                    If dic.Exists(x1) Then
                        x2 = dic(x1)
                    Else
                        x2 = UBound(a, 2)
                    End If
                    b(1, x2) = a(y1, x1)
                Next
                sh2.Cells(y2, 1).Resize(1, UBound(a, 2)) = b
                sh2.Rows(y2).Interior.Color = RGB(200, 255, 200)
                y2 = y2 + 1
            End If
        End If
    Next
End Sub
 
Спасибо!  
 
Тестирую код на своем реестре, появляется ошибка 1004. С чем это может быть связано?  
Изменено: Светлана - 16.12.2019 13:09:59
 
Приложите пример.
Достаточно первые строки с двух листов.
 
пример
 
На листе "выгрузка из базы " в ячейке I1 у вас пусто
 
спасибо. исправила. но теперь другая ошибка 9.
 
Светлана, а вариант из сообщения №8 не пробовали?
"Все гениальное просто, а все простое гениально!!!"
 
нет. пользовалась первым вариантом. Сейчас попробовала. он работает, только не учитывает что порядок столбцов в "Рабочий реестр" может быть изменен. Как в этом случае изменить код?
Изменено: Светлана - 16.12.2019 16:19:45
 
А что значит порядок столбцов? Проверочный столбец может быть не "С"? Столбцы постоянно меняются или нет?
"Все гениальное просто, а все простое гениально!!!"
 
проверочный С. остальные могут быть в ином порядке.  
Изменено: Светлана - 16.12.2019 16:46:11
 
Цитата
Светлана написал:
Наименование столбцов в обоих реестрах идентичное.
А порядок разный?
"Все гениальное просто, а все простое гениально!!!"
 
Вариант:

Скрытый текст


Но все столбцы должны быть заполнены, а не как в последнем примере часть пустых.
"Все гениальное просто, а все простое гениально!!!"
 
Светлана,
Цитата
спасибо. исправила. но теперь другая ошибка 9.
У вас на листе "Рабочий реестр" столбцов получилось больше чем на листе "выгрузка из базы",
поэтому надо переопределить массив b по этому количеству столбцов
Код
'на листе Рабочий реестр столбцов больше
          x1 = sh2.Cells(1, sh2.Columns.Count).End(xlToLeft).Column
        ReDim b(1 To 1, 1 To x1)
 
Цитата
Kuzmich написал:
У вас на листе "Рабочий реестр" столбцов получилось больше чем на листе "выгрузка из базы",
По условию такого быть не должно, потому что
Цитата
Светлана написал:
Наименование столбцов в обоих реестрах идентичное.
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim,
Я думаю, что ТС имела ввиду идентичное написание
 
Возможно, посмотрим что автор напишет по этому поводу.
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, Kuzmich отвечаю на вопросы:

1) Количество столбцов в таблицах "Выгрузка из базы", "Рабочий реестр" может быть разное
2) Порядок столбцов разный
3) Наименование некоторых столбцов идентичное (идентичное написание)
 
Попробовала вариант из ответа №23. Ошибка 9. Может быть и правда все дело в разных массивах
Цитата
Kuzmich написал:
У вас на листе "Рабочий реестр" столбцов получилось больше чем на листе "выгрузка из базы",поэтому надо переопределить массив b по этому количеству столбцов
 
Цитата
1) Количество столбцов в таблицах "Выгрузка из базы", "Рабочий реестр" может быть разное
т.е не всей информацией может быть заполнена таблица?
Цитата
2) Порядок столбцов разный
Это уже понятно, такие условия нужно сразу писать. От этоко зависит, что вы получите в итоге, рабочий код или Филькину грамоту.
Цитата
3) Наименование некоторых столбцов идентичное (идентичное написание)
А вот это совсем интересно, если ставить акцент на слове "некоторых", то и заполнятся, только некоторые столбцы.

PS: Ну а если по хорошему, то вам нужно не помочь, а сделать все с нуля с доп условиями, а это уже совсем другая ветка данного сайта.
Изменено: Nordheim - 17.12.2019 08:27:26
"Все гениальное просто, а все простое гениально!!!"
Страницы: 1 2 След.
Наверх