Страницы: 1
RSS
Поиск нужной строки по условию., VBA
 
Дорогие форумчане помогите пожалуйста!

Как можно найти строку, которая будет отвечать следующему условию:

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

То есть если ввести в textbox число 65 000, то макрос должен выдать код с первой строки 12 434 345. Если ввести 73 000 то следующую строку и код 34 467 323.
суммакод
60 00012 434 345      
70 00034 467 323
80 00056 500 301
90 00078 533 279
100 000         10 056 625
110 00022 599 235
120 00014 632 213
130 00016 665 191
140 00018 868 169
150 00021 071 147
160 00023 274 125
170 00025 471 503
180 00027 680 081
190 00029 886 359
Попыталась написать такой код, но все тщетно.
Код
Dim i, ra
Dim t

t = TextBox1.Value
ra = sha.Range(sha.Cells(1,1), sha.Cells(Rows.Count, 1).End(xlUp).Row).Value

For i = 1 to UBound(ra)
    if t>=ra(i,1) and t<ra(i+1, 1) then
       msgbox ra.offset(0,1)
    else
       end sub
    end if
next
Изменено: bekzus - 09.08.2017 22:13:19
 
Раз поленились привести файл-пример, то проверяйте сами
Код
For i = 1 To UBound(ra) - 1
    If t >= ra(i, 1) And t < ra(i + 1, 1) Then
       MsgBox ra(i, 2)
       Exit Sub
    End If
Next
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
Раз поленились привести файл-пример, то проверяйте сами
Дорогой Sanja! У меня в файле очень много страниц и ужасно все некрасиво. Мне просто стыдно его показывать. И чтобы всем было понятнее не стала его прикреплять. Спасибо Вам за код! Но он не работает почему то. Понимаю это моя вина. Вы не смогли его проверить. Сейчас создам файл удалив все остальное.
 
' Вариант 1
Код
Sub Test1()
  MsgBox Evaluate("VLOOKUP(" & TextBox1.Value & ",A1:B14,2,1)")
End Sub

Для Листа1:
Код
Sub Test1a()
  MsgBox Evaluate("VLOOKUP(" & TextBox1.Value & ",Лист1!A1:B14,2,1)")
End Sub
Изменено: ZVI - 09.08.2017 22:08:53
 
' Вариант 2
Код
Sub Test2()
  
  Dim i, ra
  Dim t, ret

  t = 65000  'TextBox1.Value
  With sha
    ra = .Range(.Cells(1, 2), .Cells(.Rows.Count, 1).End(xlUp)).Value
  End With

  ' Просмотр массива
  For i = 1 To UBound(ra)
    If t = ra(i, 1) Then
      ret = ra(i, 2)
      Exit For
    ElseIf t < ra(i, 1) Then
      If i > 1 Then ret = ra(i - 1, 2)
      Exit For
    End If
  Next
  
  ' Вывод результата
  If IsEmpty(ret) Then
    MsgBox "Не найдено"
  Else
    MsgBox "Найдено: " & ret
  End If
  
End Sub
 
ZVI работает Ваш 1 вариант. Спасибо огромное!

Один вопрос. Там нельзя указать А:B без конкретных строк?
 
Можно вместо A1:B14 записать A:B, но будет тормозить, если все числа будут меньше искомого,  так как просматривается весть столбец. Лучше укажите диапазон с запасом, например: A1:B10000 .  Или такой вариант 3:
Код
Sub Test3()
  Dim rng
  With sha
    Set rng = .Range(.Cells(1, 2), .Cells(.Rows.Count, 1).End(xlUp))
  End With
  MsgBox Evaluate("VLOOKUP(" & TextBox1.Value & "," & rng.Address & ",2,1)")
End Sub
Изменено: ZVI - 09.08.2017 22:51:04
 
ZVI, Спасибо большое. А как избежать ошибки при вводе меньшего значения?
 
Можно так, например:
Код
Sub Test1()
  On Error Resume Next
  MsgBox Evaluate("VLOOKUP(" & Textbox1.Value & ",A1:B10000,2,1)")
  If Err Then MsgBox "Не найдено"
  Err.Clear
End Sub

Sub Test3()
  Dim rng
  With sha
    Set rng = .Range(.Cells(1, 2), .Cells(.Rows.Count, 1).End(xlUp))
  End With
  On Error Resume Next
  MsgBox Evaluate("VLOOKUP(" & Textbox1.Value & "," & rng.Address & ",2,1)")
  If Err Then MsgBox "Не найдено"
  Err.Clear
End Sub
 
Здравствуйте ZVI! Я заметила, что код перестает работать когда меняешь в excel показ наименование столбцов на R1C1. Почему так происходит? Кажется Evaluate(VLookUp может применятся только когда названия столбцов через буквы A, B, C
 
А есть возможность в коде изменить стиль ссылок R1C1 на обычные A, B, C?
 
Ура! Нашла ответ Application.ReferenceStyle = xlA1 :D  
Страницы: 1
Наверх