Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Автоматическое сравнения данных Excel формата с базой данных (1С)
 
#1
19.04.2016 13:24:12
Здравствуйте, просьба подсказать где допускаю ошибку при написании кода.
Либо же скиньте примеры использования кода СчетЕслиМН; Значен; ДатаЗнач.
Описания ситуации:
Имеются два отчета: Данные от менеджеров и данные выгруженные с системы 1С.
Постановка задачи – с общей совокупности данных системы 1С проверить отчеты Менеджеров на правильность внесения данных… и указать соответственные отличия для возможной дальнейшего уточнения информации.
Ниже я прикрепляю файл-пример – где проиллюстрирую частичный прототип данных и непосредственный расчет данных в виде кода которые можно также посмотреть (ниже отдельно прикреплю имеющийся у меня на данный момент код. В файле «Пример» - на листе «Нужный вариант)» отображается ситуация к которой я хочу прийти (за исключением выделенного синим цвета ячейки (где я с помощью VBA не могу правильно использовать функцию Значен). Сейчас рассчеты проведены руками…

В этом коде мне нужно отредактировать данные:
1.  Исчисление формулы СчетЕслиМН (на данные момент выдает результат 0 – проблема – необходимо откорректировать данные выгрузки с данных 1С (перевести их в формат даты) – с помощью ДатаЗнач не могу сделать (буду очень благодарным за подсказку в этом плане – при этом при исчислении в обычном режиме с помощью формул Excel воспринимает эти данные и есть возможность исчисления (смотри лист «Нужный вариант» столбец  12).
Cells(CambRow, 12) = WorksheetFunction.CountIfs(Range("Agent"), Cells(CambRow, 3), Range("Docum"), Cells(CambRow, 1),  Range("Summ"), Cells(CambRow, 7), Range("Date1"), Cells(CambRow, 2))


2. Некоторые и данных файлов менеджеров (суммы идут как текст) – при попытке отредактировать с помощью Значен – результата не было.
Cells(CambRow, 7) = WorksheetFunction.Sum(Range(Cells(CambRow, 4), Cells(CambRow, 6)))

3. Если менеджеры продавали товар клиенту несколько раз необходимо произвести подсчет общей суммы товаров проданного клиенту за месяц:
Для этого я с общей выборки 1С данных ФИО – отобрал уникальные значения и с помощью функции СуммЕсли – узнаю общую сумму (на данном этапи этого сделать не удается): вот строка рассчета

Cells(CambRow, 20) = WorksheetFunction.SummIf(Range(Cells(2, 15), Cells(FIOLastRow, 17)), Cells(CambRow, 19), Range("Summ"))
Я использую именованные диапазоны – так что более разумно смотреть наверное в самом Коде

Решение этих пунктов помогут мне достичь конечной задачи.

Буду благодарный всем кто проявит интерес к этой задаче.
 
 
 
#2
19.04.2016 13:26:09
Вот непосредственно и сам код над которым сейчас работаю:
Код
Option Explicit

' Макрос для розрахунку даних (збігу основних показників) _
та розфарбування таблиці з проблемними місцями (при чому: проблемні _
місця переносяться на інший лист з кольором (що дає можливість краще _
оцінювати ситуацію з проблемними даними.

Sub Count_And_Print()
    Dim LastRow As Long
    Dim LastRowUP As Long
    Dim CambRow As Integer
    Dim Agent As Areas
    Dim Docum As Areas
    Dim Date1 As Areas
    Dim Summ As Areas
    Dim LastRow2 As Long
    Dim LastRowUP2 As Long
    Dim LastRowDiff As Long
    Dim FIOLastRow As Long
    Dim FIOLastRow2 As Long
    
    
    Application.ScreenUpdating = False
    Sheets("Злитий").Activate
    
    LastRow = Range("A65000").End(xlUp).Row
    LastRow2 = Range("N65000").End(xlUp).Row

    Cells(1, 7) = "Заг. Сумма"
    Cells(1, 8) = "ФІО"
    Cells(1, 9) = "Ном.Догов."
    Cells(1, 10) = "ФІО/№"
    Cells(1, 11) = "/+сумма"
    Cells(1, 12) = "/+дата"
    Cells(1, 13) = "№/Сумм"
    
    
    ActiveWorkbook.Names.Add Name:="Date1", RefersTo:=Range(Cells(2, 14), Cells(LastRow2, 14))
    ActiveWorkbook.Names.Add Name:="Agent", RefersTo:=Range(Cells(2, 15), Cells(LastRow2, 15))
    ActiveWorkbook.Names.Add Name:="Docum", RefersTo:=Range(Cells(2, 16), Cells(LastRow2, 16))
    ActiveWorkbook.Names.Add Name:="Summ", RefersTo:=Range(Cells(2, 17), Cells(LastRow2, 17))
    
    
    Range("Date1").Select
    Selection.NumberFormat = "0.00"
   
    'Необхідно суттєві доопрацювання!!!
    
    For CambRow = 2 To LastRow
        Cells(CambRow, 3) = WorksheetFunction.Trim(Cells(CambRow, 3)) ' чистка зайвих пробілів в фаміліях
        Cells(CambRow, 7) = WorksheetFunction.Sum(Range(Cells(CambRow, 4), Cells(CambRow, 6))) ' при підрахуванні суми деякі значення з _
        даних менеджерів ідуть як текст як змінити це в Excel??? які можна застосувати функції??
        
        Cells(CambRow, 8) = WorksheetFunction.CountIf(Range("Agent"), Cells(CambRow, 3))
        Cells(CambRow, 9) = WorksheetFunction.CountIf(Range("Docum"), Cells(CambRow, 1))
        Cells(CambRow, 10) = WorksheetFunction.CountIfs(Range("Agent"), Cells(CambRow, 3), Range("Docum"), Cells(CambRow, 1))
        Cells(CambRow, 11) = WorksheetFunction.CountIfs(Range("Agent"), Cells(CambRow, 3), Range("Docum"), Cells(CambRow, 1), _
        Range("Summ"), Cells(CambRow, 7))
        Cells(CambRow, 12) = WorksheetFunction.CountIfs(Range("Agent"), Cells(CambRow, 3), Range("Docum"), Cells(CambRow, 1), _
        Range("Summ"), Cells(CambRow, 7), Range("Date1"), Cells(CambRow, 2))
        Cells(CambRow, 13) = WorksheetFunction.CountIfs(Range("Docum"), Cells(CambRow, 1), Range("Summ"), Cells(CambRow, 7))
        ' на даний момент не працює необхідно вирішити _
        як можна автоматично змінити дату з вигрузки 1С (як застосувати формулу дата Знач)??
        
    Next CambRow
        
'===============================================================================================================================
' необхідно зробити відбір по значенням (тобто якщо ідуть повтори/або відсутні (значення відмінне від 1)
' фарбуваня кольором відповідних значень
' переніс проблемних рядків на окремий лист (з кольором проблемних даних) та поряд з даними 1С
' Різниця значень у понад 1 одиницю??? (що робити)
    For CambRow = 2 To LastRow
    If Cells(CambRow, 12) = 0 Then
    Range(Cells(CambRow, 1), Cells(CambRow, 7)).Select
    Selection.Interior.Color = 35535
    End If
    
    If Cells(CambRow, 11) = 0 And Cells(CambRow, 8) <> 0 Then
        Range(Cells(CambRow, 4), Cells(CambRow, 7)).Select
        Selection.Interior.Color = 65535
    End If
    
    If Cells(CambRow, 11) > Cells(CambRow, 12) Then
        Cells(CambRow, 2).Select
        Selection.Interior.Color = 65535
    End If
    
    If Cells(CambRow, 8) = 0 And Cells(CambRow, 9) = 0 And Cells(CambRow, 10) = 0 And _
        Cells(CambRow, 11) = 0 And Cells(CambRow, 12) = 0 And Cells(CambRow, 13) = 0 Then
        Range(Cells(CambRow, 1), Cells(CambRow, 7)).Select
        Selection.Interior.Color = 5535
    End If
    
    
    
    If Cells(CambRow, 8) <> Cells(CambRow, 9) Then
        If Cells(CambRow, 8) > Cells(CambRow, 9) Then
            Cells(CambRow, 1).Select
            Selection.Interior.Color = 65535
        ElseIf Cells(CambRow, 8) < Cells(CambRow, 9) Then
            Cells(CambRow, 3).Select
            Selection.Interior.Color = 65535
        End If
    End If
    
    Next CambRow
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Перенесення даних з листа "Злитий" в лист "Розбіжності" (для відображення обєктивної картини)
    Sheets("Злитий").Activate
    
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Доп свод данных для исчесления общей суммы и соответственной раскарски данных...
    
    FIOLastRow = Cells(65000, 15).End(xlUp).Row
    'ActiveWorkbook.Names.Add Name:="Agent", RefersTo:=Range(Cells(2, 15), Cells(FIOLastRow, 15))
    Range("Agent").Select
    Selection.Copy
    Cells(2, 19).Select
    ActiveSheet.Paste
    FIOLastRow2 = Cells(65000, 19).End(xlUp).Row
    ActiveWorkbook.Names.Add Name:="Agent2", RefersTo:=Range(Cells(2, 19), Cells(FIOLastRow, 19))
   ' ActiveWorkbook.Names.Add Name:="Summ", RefersTo:=Range(Cells(2, 17), Cells(FIOLastRow, 17))
    ActiveSheet.Range("Agent2").RemoveDuplicates Columns:=1, Header:=xlNo ' '' Не понимаю???
    FIOLastRow2 = Cells(65000, 19).End(xlUp).Row
    For CambRow = 2 To FIOLastRow2 ' 438
    'Cells(CambRow, 20) = WorksheetFunction.SummIf(Range(Cells(2, 15), Cells(FIOLastRow, 17)), Cells(CambRow, 19), Range("Summ")) ' сейчас не могу сделать подсчет...
    Next CambRow
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


    Sheets("Злитий").Activate
    LastRow = Range("A65000").End(xlUp).Row
    Sheets("Розбіжності").Activate
    
    
    Cells(11, 1) = "№ дог"
    Cells(11, 2) = "Дата"
    Cells(11, 3) = "Ф.И.О. клиента"
    Cells(11, 4) = "Заг. Сумма"
    
    
 '''''' Перенесення виділених даних ' зараз працює правильно!!!
        'Перенос выделенных данных, сейчас работает правильно!... но выше выведенная формула по _
        столбцу 12 выбивает везде 0... (отредактировать формулу)!
    
    For CambRow = 2 To LastRow
        Sheets("Злитий").Activate
        If Cells(CambRow, 12) = 0 Then
            Range(Cells(CambRow, 1), Cells(CambRow, 3)).Select
            Selection.Copy
            Sheets("Розбіжності").Activate
            LastRowDiff = Range("A65000").End(xlUp).Row ' Визначаю останній заповнений рядок
            Sheets("Розбіжності").Cells(LastRowDiff + 1, 1).Select
            ActiveSheet.Paste
            Sheets("Злитий").Activate
            Cells(CambRow, 7).Select
            Selection.Copy
            Sheets("Розбіжності").Activate
            Sheets("Розбіжності").Cells(LastRowDiff + 1, 4).Select
            ActiveSheet.Paste
        End If
    Next CambRow
    
    
    
    
    Sheets("Розбіжності").Activate
    Range("B11").Select
    Selection.AutoFilter
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    
    
    
    
    Application.ScreenUpdating = True
    
    
    MsgBox "Перенесення даних завершено"

End Sub
 
 
 
Страницы: 1
Наверх