ИНДЕКС(лист3!$G$1:$G$1000;ПОИСКПОЗ(B2;--лист3!$A$1:$A$1000;))

ИНДЕКС(лист3!$G$1:$G$1000;ПОИСКПОЗ(B2&"";лист3!$A$1:$A$1000;))

Sub Макрос1()
Range("I1").Select
ActiveCell.FormulaR1C1 = _
"=RC[-7]&""/""&INDEX('3'!R1C7:R701C7,MATCH(RC[-7]&"""",'3'!R1C1:R701C1,))"
Range("I1").Select
Selection.AutoFill Destination:=Range("I1:I555"), Type:=xlFillDefault
Range("I1:I555").Select
Columns("I:I").Select
Range("I553").Activate
Selection.Copy
Columns("H:H").Select
Range("H553").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

=ВПР(B1&"";'3'!$A$25:$M$500;8;0)

Sub ИзКС2вГС()
        'копировать видимый массив из КС2 на новый лист
        'выделить предварительно массив!!!
        'Отключение обновления экрана для ускорения работы макроса
Application.ScreenUpdating = False
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
        'Sheets.Add After:=ActiveSheet  'первоначально
        'Sheets.Add Before:=Sheets(1) 'After:=ActiveSheet   'апострофф
        'ActiveSheet.Name = 111111111                        'апострофф
Sheets.Add(Before:=Sheets(1)).Name = "ГрандСмета"    'Пелена
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
        'красота в третьем и четвертом столбце
Columns  ("C : D").Select  'что-то изменяется...   пробелы удалите
Selection.ColumnWidth = 40
Cells.Select
Selection.RowHeight = 40
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
            'удалить пустые строки Wasilich
PS = Range("B" & Rows.Count).End(xlUp).Row
For i = PS To 1 Step -1
If Cells(i, 1) = "" Or Mid(Cells(i, 1), 1, 1) = "." Or Mid(Cells(i, 1), 1, 1) = Chr(133) Then
Rows(i).Delete
End If
Next
            'для всех C D     формула tt  МВТ,  Manyasha
For Each cell In Range("c1:d" & Cells(Rows.Count, "d").End(xlUp).Row)
cell.Value = tt(cell.Value) 'вызов UDF от МВТ
Next cell
            'Минуса убрать с цены  (минус из 7-ого столбца в 6-ой) _Boroda_
For i = 1 To Range("F" & Rows.Count).End(xlUp).Row
If Cells(i, 7) < 0 Then
Cells(i, 7) = -Cells(i, 7)
Cells(i, 6) = -Abs(Cells(i, 6))
End If
Next
                 'стоимость материалов из сметы 3 в ГрандСмета
Range("I1").Select
ActiveCell.FormulaR1C1 = _
"=RC[-7]&""                    ""&VLOOKUP(RC[-7]&"""",'3'!R25C1:R500C13,7,0)"  'nilem
            '"=RC[-7]&""                    ""&INDEX('3'!R1C7:R701C7,MATCH(RC[-7]&"""",'3'!R1C1:R701C1,))"  'Manyasha
Range("I1").Select
Selection.AutoFill Destination:=Range("I1:I105"), Type:=xlFillDefault
Range("I1:I105").Select
Columns("I:I").Select
Range("I97").Activate
Selection.Copy
Columns("H:H").Select
Range("H97").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
            'СохрБезЗапроса Апострофф
ActiveWindow.SmallScroll Down:=-100
Range("A8").Select
ActiveWindow.View = xlNormalView
ActiveWindow.Zoom = 100
Workbooks.Application.DisplayAlerts = False
Excel.ActiveWorkbook.Save
Application.Quit
            'Включение обновления экрана для ускорения работы макроса
Application.ScreenUpdating = True
End Sub

   
Function tt(Text As String)    
Dim obj As Object       
Text = WorksheetFunction.Trim(Text)       
With CreateObject("VBScript.Regexp")        
.Ignorecase = False       
.MultiLine = False        
.Pattern = "(\d{1,3}-\d{1,3}-\d{1,3}- ?\d{1,3}) ([А-яЁё]+( [а-яё])?)"        
Set obj = .Execute(Text)        
If obj.Count > 0 Then Text = obj(0).submatches(1) & " " & obj(0).submatches(0)       
End With       
tt = Text       
End Function