Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.77/13: Рейтинг темы: голосов - 13, средняя оценка - 4.77
0 / 0 / 0
Регистрация: 04.11.2012
Сообщений: 10
1

Поиск ближайшего подходящего значения из таблицы

20.07.2014, 15:19. Просмотров 2716. Ответов 2
Метки нет (Все метки)


Здравствуйте,

в Excel у меня есть таблица из разных значений P, которым соответствуют разные значения DCr. Необходимо, чтобы при установленном значении P по умолчанию в ячейку записывалось бы значение от DCr, соответствующее этому установленному P. Дело в том, что значение P-установленного не совпадает со значением P-табличного, а находится в промежутке между 2-мя числами, и вот тут, по идее, программа должна находить ближайшее к этому установленному значение из таблицы, и с этим полученным P-табличным присваивать ячейке DCr соответствующее значение DCr по таблице. Но, почему-то, записывает нули. Excel файл прикреплён с картинкой-пояснением. Вот код программы

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub мак()
Dim ina, iko, j, i1, j1, i2, j2  As Long
 
Dim P, P1, P2, Pavg, DCr As Currency
 
Set SH1 = ActiveWorkbook.Sheets("Лист1")
Set SH2 = ActiveWorkbook.Sheets("Лист2")
 
ina = 2
iko = 11
j = 9
i2 = 2
j2 = 14
i1 = 2
j1 = 10
 
For i1 = ina To iko
 
SH1.Select
 
P = SH1.Cells(i1, j1).Value
 
SH2.Select
 
For i2 = 2 To 185
If (P > SH2.Cells(i2, j2).Value) And (P < SH2.Cells(i2 + 1, j2).Value) Then
P1 = SH2.Cells(i2, j2).Value
P2 = SH2.Cells(i2 + 1, j2).Value
Pavg = (P1 + P2) / 2
End If
Next i2
 
If P < Pavg Then
DCr = SH2.Cells(i2, j2 + 1).Value
Else
DCr = SH2.Cells(i2 + 1, j2 + 1).Value
End If
 
SH1.Select
SH1.Cells(i1, j1).Value = DCr
 
Next i1
 
 
End Sub
0
Вложения
Тип файла: rar Книга.rar (52.5 Кб, 18 просмотров)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
20.07.2014, 15:19
Ответы с готовыми решениями:

Определение ближайшего адреса ячейки, подходящего по углу
Добрый день форумчане. Возникла непростая проблема. Помогите ее решить. Суть проблемы такая....

Поиск последнего подходящего значения
Добрый день. Просьба подсказать. На рисунке фрагмент запроса из конструктора. Как прописать так,...

Поиск ближайшего значения
Имеются вычисленные данные, необходимо найти в таблице запись, которая по сравниваемому полю выдаст...

Notepad++ Регулярные выражения поиск ближайшего блока после нахождения необходимого значения в коде
Добрый день! Прошу подсказать: есть примерно такая структура &lt;body&gt; &lt;tag&gt; &lt;number=1&gt;...

2
81 / 18 / 1
Регистрация: 22.05.2013
Сообщений: 32
24.07.2014, 22:11 2
vihac, можно стандартной функцией ВПР (VLOOKUP) обойтись. У него последний параметр отвечает за приблизительный поиск.

Есть способ через VBA, но сначала этот попробуйте
0
Заблокирован
25.07.2014, 07:41 3
vihac, найдите 10 отличий -
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub мак()
Dim ina As Long, iko As Long, j As Long, i1 As Long, j1 As Long, i2 As Long, j2 As Long, f As Long
 
Dim P As Currency, P1 As Currency, P2 As Currency, Pavg As Currency, DCr As Currency
 
Set SH1 = ActiveWorkbook.Sheets("Лист1")
Set SH2 = ActiveWorkbook.Sheets("Лист2")
 
ina = 2
iko = 11
j = 9
i2 = 2
j2 = 14
i1 = 2
j1 = 10
 
For i1 = ina To iko
  SH1.Select
  P = SH1.Cells(i1, j1 - 1).Value
  SH2.Select
  For i2 = 2 To 185
    If (P >= SH2.Cells(i2, j2).Value) And (P < SH2.Cells(i2 + 1, j2).Value) Then
      P1 = SH2.Cells(i2, j2).Value
      P2 = SH2.Cells(i2 + 1, j2).Value
      Pavg = (P1 + P2) / 2
      f = i2
      Exit For
    End If
  Next i2
   
  If P < Pavg Then
    DCr = SH2.Cells(f, j2 + 1).Value
  Else
    DCr = SH2.Cells(f + 1, j2 + 1).Value
  End If
   
  SH1.Select
  SH1.Cells(i1, j1).Value = DCr
   
Next i1
 
End Sub
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
25.07.2014, 07:41

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь или здесь.

Поиск подходящего CMS
Доброго времени суток! Столкнулся с проблемой выбора подходящего движка, к сожалению поиски в гугле...

Токовый сенсор. Поиск подходящего ..
Собираюсь мерить потребление тока устройством в диапазоне 0-30 мА, напряжение питания 3,3 В....

Acer Aspire: поиск подходящего шлейфа
Уважаемые форумчане, приветствую! Нужна помощь в одном нелегком деле... Отважился на ремонт...

Поиск значения по столбцу таблицы
Здравствуйте! В моей программе организован поиск строки в файле, хотелось бы улучшить поиск и...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.