1. Мегаконкурс в апреле "Приведи друзей на codeby". Дарим деньги, подписку на журнал хакер и выдаем статус "Paid Access". Подробнее ...

    Скрыть объявление

Сравнение Столбцов Двух Листов Одной Книги

Тема в разделе "Visual Basic", создана пользователем clas, 24 ноя 2013.

Наш партнер Genesis Hackspace
  1. clas

    clas New Member

    Регистрация:
    24 ноя 2013
    Сообщения:
    2
    Симпатии:
    0
    Доброго времени дня.
    Ув. программисты помогите с макросом,проблема такова-есть два листа одной книги с данными,нужно сравнивать столбец 5 первого листа со столбцом 5 второго листа,а повторяющиеся в них значения выводить в лист три столбец 1.тоже самое с столбцами 6 сравнивать и повторяющиеся значения выводить в столбец 2 третьего листа. Данные первого и второго листов постоянно обновляются и поэтому чтобы не путаться, каждая новая выводимая цифра в лист три должна стоять первой сверху и если возможно в экселе такое,издавать звуковой сигнал и выделять цветом.

    Заранее спасибо.
     

    Вложения:

  2. alex77755

    alex77755 Well-Known Member

    Регистрация:
    15 фев 2009
    Сообщения:
    128
    Симпатии:
    0
    Да, в принципе, это возможно.
    Вопрос: по какому событию это делать?
     
  3. clas

    clas New Member

    Регистрация:
    24 ноя 2013
    Сообщения:
    2
    Симпатии:
    0
    Ув. alex77755 спасибо Вам, что обратили внимание на мою проблему,но дело в том что я очень далек от экселя и даже не могу ответить на ваш вопрос, по какому событию это делать?У меня есть макрос который из первых двух столбцов первого и второго листа (данные получаю по DDE)отфильтровывает в 3,4,5,6 столбец, может его просто дописать чтобы решить задачу третьего листа или как то иначе? Может для удобства Вам будет проще зайти в мой комп через удаленный доступ
    для решения этой задачи,а то я толком даже не могу объяснить что мне надо а надо очень.

    вот сам макрос-


    Sub v3_ForCLASS()
    Dim mARR(), i&
    With ActiveSheet: mARR = .UsedRange.Value
    If UBound(mARR, 2) < 6 Then ReDim Preserve mARR(1 To UBound(mARR, 1), 1 To 6)
    With CreateObject("scripting.dictionary")
    For i = 3 To UBound(mARR, 1)
    If CLng(mARR(i, 1)) < CLng(mARR(i, 2)) Then
    If Not .exists(mARR(i, 2) & ";;;" & 3) Then
    .Add mARR(i, 2) & ";;;" & 3, i & ";;;" & 0: mARR(i, 3) = mARR(i, 2)
    ElseIf CLng(Split(.Item(mARR(i, 2) & ";;;" & 3), ";;;")(1)) < 2 Then
    Split(.Item(mARR(i, 2) & ";;;" & 3), ";;;")(1) = CLng(Split(.Item(mARR(i, 2) & ";;;" & 3), ";;;")(1)) + 1
    mARR(i, 3) = mARR(i, 2): mARR(Split(.Item(mARR(i, 2) & ";;;" & 3), ";;;")(0), 5) = mARR(i, 2)
    End If
    ElseIf CLng(mARR(i, 1)) > CLng(mARR(i, 2)) Then
    If Not .exists(mARR(i, 2) & ";;;" & 4) Then
    .Add mARR(i, 2) & ";;;" & 4, i & ";;;" & 0: mARR(i, 4) = mARR(i, 2)
    ElseIf CLng(Split(.Item(mARR(i, 2) & ";;;" & 4), ";;;")(1)) < 2 Then
    Split(.Item(mARR(i, 2) & ";;;" & 4), ";;;")(1) = CLng(Split(.Item(mARR(i, 2) & ";;;" & 4), ";;;")(1)) + 1
    mARR(i, 4) = mARR(i, 2): mARR(Split(.Item(mARR(i, 2) & ";;;" & 4), ";;;")(0), 6) = mARR(i, 2)
    End If
    End If
    Next 'i
    End With
    .UsedRange.Cells(1).Resize(UBound(mARR, 1), UBound(mARR, 2)).Value = mARR
    End With
    Erase mARR: MsgBox Space(10) & "D O N E!"
    End Sub
     
  4. alex77755

    alex77755 Well-Known Member

    Регистрация:
    15 фев 2009
    Сообщения:
    128
    Симпатии:
    0
    Для адекватного решения задачи нужен образец файла.
    И более детальное объяснение что хотите получить.
    Удалённым доступом никогда не пользовался даже не пробовал.
    Сюда захожу не часто. Можете скинуть файл и описание на мыло (в подписи)
     
Загрузка...

Поделиться этой страницей