Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 09.01.2013, 15:44   #11
ikki_pf
Форумчанин
 
Регистрация: 25.02.2012
Сообщений: 166
По умолчанию

макрос (по первому файлу)

1. как оно озвучено
Код:
Sub t()
  Dim d As Object, a, b, i&, lr&
  Set d = CreateObject("scripting.dictionary")
  With Range([a4], Cells(Rows.Count, 1).End(xlUp))
    a = .Value
    b = .Offset(, 3).Value
  End With
  For i = 1 To UBound(a)
    If d.exists(a(i, 1)) Then
      If d.Item(a(i, 1)) > b(i, 1) Then d.Item(a(i, 1)) = b(i, 1)
    Else
      d.Add a(i, 1), b(i, 1)
    End If
  Next
  For i = 1 To UBound(a)
    b(i, 1) = d.Item(a(i, 1))
  Next
  [d4].Resize(UBound(a)).Value = b
End Sub
2. как оно "по-правильному"
Код:
Sub t()
  Dim d As Object, a, b, i&, lr&
  Set d = CreateObject("scripting.dictionary")
  With Range([a4], Cells(Rows.Count, 1).End(xlUp))
    a = .Value
    b = .Offset(, 3).Value
  End With
  For i = 1 To UBound(a)
    If d.exists(a(i, 1)) Then
      If d.Item(a(i, 1)) > b(i, 1) And b(i, 1) > 0 Then d.Item(a(i, 1)) = b(i, 1)
    Else
      d.Add a(i, 1), b(i, 1)
    End If
  Next
  For i = 1 To UBound(a)
    b(i, 1) = d.Item(a(i, 1))
  Next
  [d4].Resize(UBound(a)).Value = b
End Sub
ikki_pf вне форума Ответить с цитированием
Старый 09.01.2013, 16:39   #12
Artem_85
Пользователь
 
Регистрация: 21.02.2012
Сообщений: 82
По умолчанию

Цитата:
Сообщение от ikki_pf Посмотреть сообщение
макрос (по первому файлу)

1. как оно озвучено
Код:
Sub t()
  Dim d As Object, a, b, i&, lr&
  Set d = CreateObject("scripting.dictionary")
  With Range([a4], Cells(Rows.Count, 1).End(xlUp))
    a = .Value
    b = .Offset(, 3).Value
  End With
  For i = 1 To UBound(a)
    If d.exists(a(i, 1)) Then
      If d.Item(a(i, 1)) > b(i, 1) Then d.Item(a(i, 1)) = b(i, 1)
    Else
      d.Add a(i, 1), b(i, 1)
    End If
  Next
  For i = 1 To UBound(a)
    b(i, 1) = d.Item(a(i, 1))
  Next
  [d4].Resize(UBound(a)).Value = b
End Sub
2. как оно "по-правильному"
Код:
Sub t()
  Dim d As Object, a, b, i&, lr&
  Set d = CreateObject("scripting.dictionary")
  With Range([a4], Cells(Rows.Count, 1).End(xlUp))
    a = .Value
    b = .Offset(, 3).Value
  End With
  For i = 1 To UBound(a)
    If d.exists(a(i, 1)) Then
      If d.Item(a(i, 1)) > b(i, 1) And b(i, 1) > 0 Then d.Item(a(i, 1)) = b(i, 1)
    Else
      d.Add a(i, 1), b(i, 1)
    End If
  Next
  For i = 1 To UBound(a)
    b(i, 1) = d.Item(a(i, 1))
  Next
  [d4].Resize(UBound(a)).Value = b
End Sub

или я что то не так делаю или он не работает))))))
Artem_85 вне форума Ответить с цитированием
Старый 09.01.2013, 16:44   #13
ikki_pf
Форумчанин
 
Регистрация: 25.02.2012
Сообщений: 166
По умолчанию

Цитата:
Сообщение от Artem_85 Посмотреть сообщение
или я что то не так делаю или он не работает))))))
не гадалка я
не потомственная
что именно вы делаете, как делаете, и как именно "он" у вас "не работает" - сказать не могу.
но догадываюсь - судя по тому, как вы цитируете посты.

у меня работает.
ikki_pf вне форума Ответить с цитированием
Старый 09.01.2013, 16:46   #14
Artem_85
Пользователь
 
Регистрация: 21.02.2012
Сообщений: 82
По умолчанию

Цитата:
Сообщение от ikki_pf Посмотреть сообщение
не гадалка я
не потомственная
что именно вы делаете, как делаете, и как именно "он" у вас "не работает" - сказать не могу.
но догадываюсь - судя по тому, как вы цитируете посты.

у меня работает.
в столбце D большинство нули
Artem_85 вне форума Ответить с цитированием
Старый 09.01.2013, 16:50   #15
Artem_85
Пользователь
 
Регистрация: 21.02.2012
Сообщений: 82
По умолчанию

Все работает...спасибо огромное........)))))))))))
Artem_85 вне форума Ответить с цитированием
Старый 09.01.2013, 16:54   #16
ikki_pf
Форумчанин
 
Регистрация: 25.02.2012
Сообщений: 166
По умолчанию

второй макрос тоже немножко нулей даёт.
но это уж вы с исх.данными разбирайтесь.
возможно, где-то в наименованиях неточность.
макрос проверяет ПОЛНОЕ соответствие - с учётом всех кавычек, точек-запятых и пробелов.
ikki_pf вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
замена минимального числа максимальным vovik4385 Общие вопросы C/C++ 0 29.03.2012 18:34
условие минимального значения у bigildar Помощь студентам 2 13.11.2011 17:47
(Псевдо)Рандомный массив и поиск минимального значения в нем Zero&One Помощь студентам 0 30.09.2011 15:39
Поиск максимального и минимального значения в массиве WIN32APIist Общие вопросы C/C++ 5 28.12.2010 00:24
поиск ближайшего минимального значения на sql nuevegramodelamor Помощь студентам 7 11.05.2010 20:21