Выборка в диапазоне значения по заданному промежутку и перенести на другой лист excel vba

[ac1-caesar]

Уважаемые форумчане!

Пожалуйста, подскажите как сделать выборку значений в диапазоне по заданному промежутку. (Из-за отсутствия функции between, не знаю как это решается).
Диапазон включает в себя 3 столбца.
После выборки, в каждой строке этого диапазона нужно определить минимальное значение и перенести это минимальное значение на лист results так же (т.е. если минимальное значение из 1-го столбца диапазона, то и перенести его в 1-й и т.д.)
Файл в скрепке (попытка начала кода).

[IgorGO]

наверное тут опечатка:

If cell.Value <= Me.TextBoxFrom.Value ...
If cell.Value >= Me.TextBoxFrom.Value ...

[ac1-caesar]

Сообщение от IgorGO

наверное тут опечатка:

Согласен, принимается.

[ac1-caesar]

У меня получается вставляет по три значения в столбец. Т.е. если строка попадает в выбираемый промежуток, то вставляет значение столбца "DY", "FH" и "FC".

[alex77755]

Из-за отсутствия функции between

А куда ж она делась?
Никто не мешает написать запрос к листу с between

[ac1-caesar]

Подскажите как?

[IgorGO]

я думаю, если бы кто-то понял что нужно сделать - уже выложили бы готовый код

[ac1-caesar]

к примеру промежуток задан от -20 до 30:
на листе main в первой строке
в колонке "TASK NUMBER" - 278211-L505-1
в колонке "DESCRIPTION" - CONTROL UNIT-SLAT
в колонке "DY" - (-18)
в колонке "FH" - (28)
в колонке "FC" - (123)

в соответствии с заданным промежутком эта строка попадает под наш выбор так как минимальное значение в просматриваемом диапазоне -18.

Теперь на листе results эта строка должна отобразиться так:
в первой колонке - 278211-L505-1
во второй - (18)
в третьей - ""
в четвертой - ""

и так по всей таблице

[IgorGO]

а это попадает
в колонке "DY" - (28)
в колонке "FH" - (-18)
в колонке "FC" - (123)
в тот же диапазон?

[alex77755]

Сообщение от ac1-caesar

Подскажите как?

Просто принцип из другого решения:

Public Function ADO_R_Dmitry(ByVal StrSql$, ByVal FilePath$, ByVal OutputRange As Range, _
ByVal FieldsName As Boolean, ByVal OutputFieldsName As Boolean, Optional TypeBase As Long = 0, Optional ColumnDelimeter As String = ",")
Abs
'==============================================================================
'* Автор R Dmitry
'==============================================================================
Dim sCon As String, FieldName As String
Dim rs As Object, cn  As Object
Set rs = CreateObject("ADODB.Recordset")
Set cn = CreateObject("ADODB.Connection")
If FieldsName Then FieldName = "Yes" Else FieldName = "No"

If TypeBase > 0 Then
    sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
    If TypeBase = 1 Then sCon = sCon & FilePath & ";User Id=admin;Password=;" 'Access
   'If TypeBase = 2 Then sCon = "Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=" & FilePath
    If TypeBase = 2 Then sCon = sCon & FilePath & ";Extended Properties=dBASE IV;User ID=Admin;Password=;" 'DBF
    'If TypeBase = 3 Then sCon = sCon & FilePath & ";Extended Properties=text;HDR=" & FieldName & ";FMT=Delimited " & ColumnDelimeter 'TXT
    If TypeBase = 3 Then sCon = "Driver={Microsoft Text Driver (*.txt; *.csv)};Dbq=" & FilePath & ";Extensions=asc,csv,tab,txt;"
Else
    Select Case Val(Application.Version)
        Case Is < 12
            sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath _
              & ";Extended Properties=""Excel 8.0;HDR=" & FieldName & ";IMEX=1"";"
        Case 12, 14
            sCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath _
            & ";Extended Properties=""Excel 12.0;HDR=" & FieldName & ";IMEX=1"";"
    End Select
End If
cn.Open sCon
If Not cn.State = 1 Then Exit Function
Set rs = cn.Execute(StrSql)
If Not FieldsName Then OutputFieldsName = False
 If OutputFieldsName Then
    For i = 0 To rs.Fields.Count - 1
    OutputRange.Offset(0, i) = rs.Fields(i).Name
    Next
    Set OutputRange = OutputRange.Offset(1, 0)
 End If
 DoEvents
OutputRange.CopyFromRecordset rs
rs.Close:  cn.Close
Set cn = Nothing: Set rs = Nothing
End Function

Sub test()
Dim strSql2$
Dim Lr&
Lr = Cells(Rows.Count, 1).End(xlUp).Row
If Lr < 3 Then Lr = 3
Range("a3:q" & Lr).ClearContents
strSql2 = "select * from [Янв_Февр$] where [Код товара]like '%" & [a2].Value & "%'"
Call ADO_R_Dmitry(strSql2, ThisWorkbook.FullName, Sheets("Поиск").[a3], True, False)
End Sub

Sub test2()
Dim strSql2$
Dim Lr&
Lr = Cells(Rows.Count, 1).End(xlUp).Row
If Lr < 3 Then Lr = 3
Range("a3:q" & Lr).ClearContents
strSql2 = "select * from [Мар_Апр$] where [Код товара]like '%" & [a2].Value & "%'"
Call ADO_R_Dmitry(strSql2, ThisWorkbook.FullName, Sheets("Поиск").[a3], True, False)
End Sub

Если уж хочешь запросом.
Лично мне проще было бы загнать в массив и выбрать.