Добрый день дамы и господа Сегодня с утра столкнулся с новым представлением информации. Только вчера обсуждали зло от объединённых ячеек, как оп... и я встретил новое зло "объединённые числа" в одной ячейке. Я примерно знаю как раскидать по новым ячейкам, но вдруг есть более простой способ. Суть: В одной ячейке E27 находятся два числа 10 и 2, которые разделены чертой таким образом, что 10 представлено, как числитель, а 2 - знаменатель. В соседней ячейке F27 такая же история: 3-числитель, 4-знаменатель. (хотя числитель и знаменатель - это не верно - ибо черта не дробная, а используется простое подчеркивание) Нужно рассчитать разность =10-2-3 в ячейке K27. У меня в запасах есть похожий код на разделитель текста внутри ячейки, но там делителем является "*", а здесь же пробелы: " " - такие вот с переносом на другую строку/подстроку. Да и разброс идёт на чётко указанные ячейки, здесь [vba]
Код
With Sheets("3") st = Split(.[K27].Value, " ") .[M27] = Trim$(st(0)) .[N27] = Trim$(st(1))
[/vba] , но беда в том что ячеек больше и они не всегда E27, F27 и K27 Я пытался вытащить объединенные цифры по отдельности в соседние ячейки M27, N27, O27 и потом применить формулу разности, но не знаю как для каждого последующего, неизвестно каким столбцом заканчивающее произвести расчет. Надеюсь не путано. Тема очень похоже на эту
Добрый день дамы и господа Сегодня с утра столкнулся с новым представлением информации. Только вчера обсуждали зло от объединённых ячеек, как оп... и я встретил новое зло "объединённые числа" в одной ячейке. Я примерно знаю как раскидать по новым ячейкам, но вдруг есть более простой способ. Суть: В одной ячейке E27 находятся два числа 10 и 2, которые разделены чертой таким образом, что 10 представлено, как числитель, а 2 - знаменатель. В соседней ячейке F27 такая же история: 3-числитель, 4-знаменатель. (хотя числитель и знаменатель - это не верно - ибо черта не дробная, а используется простое подчеркивание) Нужно рассчитать разность =10-2-3 в ячейке K27. У меня в запасах есть похожий код на разделитель текста внутри ячейки, но там делителем является "*", а здесь же пробелы: " " - такие вот с переносом на другую строку/подстроку. Да и разброс идёт на чётко указанные ячейки, здесь [vba]
Код
With Sheets("3") st = Split(.[K27].Value, " ") .[M27] = Trim$(st(0)) .[N27] = Trim$(st(1))
[/vba] , но беда в том что ячеек больше и они не всегда E27, F27 и K27 Я пытался вытащить объединенные цифры по отдельности в соседние ячейки M27, N27, O27 и потом применить формулу разности, но не знаю как для каждого последующего, неизвестно каким столбцом заканчивающее произвести расчет. Надеюсь не путано. Тема очень похоже на эту Yar4i
Ну или макросом побаловаться. Выделив две ячейки (с условием что они соседние). [vba]
Код
Sub www() st = Selection.Row kl = Selection.Column C = Trim(Cells(st, kl)) If C = "" Then Exit Sub x = Mid(C, 1, InStr(C, " ") - 1) y = Mid(C, InStrRev(C, " ") + 1, Len(C)) C = Trim(Cells(st, kl + 1)) z = Mid(C, 1, InStr(C, " ") - 1) s = x - y - z MsgBox s End Sub
[/vba] Это, как информация для размышления.
Ну или макросом побаловаться. Выделив две ячейки (с условием что они соседние). [vba]
Код
Sub www() st = Selection.Row kl = Selection.Column C = Trim(Cells(st, kl)) If C = "" Then Exit Sub x = Mid(C, 1, InStr(C, " ") - 1) y = Mid(C, InStrRev(C, " ") + 1, Len(C)) C = Trim(Cells(st, kl + 1)) z = Mid(C, 1, InStr(C, " ") - 1) s = x - y - z MsgBox s End Sub
[/vba] Это, как информация для размышления.Wasilich
Спасибо. Формула классная. Вставлю её. (пока не колупал её, но она работает) Поколупал её, она не срабатывает если E27 или F27 не содержит двухэтажные данные.
Спасибо. Формула классная. Вставлю её. (пока не колупал её, но она работает) Поколупал её, она не срабатывает если E27 или F27 не содержит двухэтажные данные.
я и писал - если там не текст то можно предварительно проверить. А не текст - значит там число и его не надо обрабатывать? а прото взять. добавить условие элементарно, вопрос только в том что при этом это будет всегда значение "над чертой"?
я и писал - если там не текст то можно предварительно проверить. А не текст - значит там число и его не надо обрабатывать? а прото взять. добавить условие элементарно, вопрос только в том что при этом это будет всегда значение "над чертой"?
Спасибо работает и с не дробью и с минусом. Так я и не понял как вы дробные в не дробные превращаете, но это великолепно. Какая-то сметная программа выдает такие ячейки и... вотъ Всем добра
Спасибо работает и с не дробью и с минусом. Так я и не понял как вы дробные в не дробные превращаете, но это великолепно. Какая-то сметная программа выдает такие ячейки и... вотъ Всем добраYar4i
Сообщение отредактировал Yar4i - Понедельник, 16.01.2017, 13:37
нет нет только ноль (пустая ячейка) Спасибо. Ааааааааа это классно!!! Работает.
Надеюсь кому-нибудь пригодится в КС-2 форме с 8 графами (восьмиграфке) представить информацию о стоимости материальных ресурсов из расценок с работами, и при этом имея смету с 10-ти графами в неудобном двуэтажном виде, заключающем в одну ячейку несколько числовых значений (ПЗ и оплаты труда основных рабочих, Эксплуатации машин и в т.ч. оплаты труда, Трудозатр. осн. рабочих и Трудозатр. машинистов уже умноженные на весь сметный объём) [vba]
Код
Sub КС2_8_10двухэтажные() 'выделить предварительно массив! 'переименовать предварительно лист со сметой в "0" ! 'Отключение обновления экрана для ускорения работы макроса Application.ScreenUpdating = False Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy 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, 2) = "" Or Mid(Cells(i, 2), 1, 1) = "." Or Mid(Cells(i, 2), 1, 1) = Chr(133) Then Rows(i).Delete End If Next 'для всех D формула tt МВТ, Manyasha For Each cell In Range("d1:d" & Cells(Rows.Count, "d").End(xlUp).Row) cell.Value = tt(cell.Value) 'вызов UDF от МВТ Next cell 'переименовать, ибо отрывается буква от последующего слова Range("D1:D777").Replace "ГЭСН а", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН б", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН в", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН г", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН д", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН е", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН ж", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН з", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН и", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСНм и", "ГЭСНм", xlPart 'проверь Range("D1:D777").Replace "ГЭСН к", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН л", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН н", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН о", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН п", "ГЭСН", xlPart 'проверь Range("D1:D777").Replace "ГЭСН с", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН т", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН у", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН ф", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН х", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН ц", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН ч", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН ш", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН щ", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН ю", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН я", "ГЭСН", xlPart Range("D1:D777").Replace "ФССЦ", "_______________", xlPart Range("D1:D777").Replace "СЦМ", "_______________", xlPart Range("D1:D777").Replace "ФСЦМ", "_______________", xlPart Range("D1:D777").Replace "С1", "_______________С1", xlPart Range("D1:D777").Replace "Т 1 - 1", "_______________", xlPart Range("D1:D777").Replace "Т 1-1", "_______________", xlPart Range("D1:D777").Replace "Е1303-4-17 К=2", "г13-03-04-17", xlPart Range("D1:D777").Replace "Е0905-2-1 изм.вып.1", "г09-05-002-1", xlPart Range("D1:D777").Replace "Е1303-4-5 К=2", "г13-03-4-5", xlPart Range("D1:D777").Replace "Е0501-117-1", "г05-01-117-1", xlPart Range("D1:D777").Replace "Е0906-24", "г09-06-24", xlPart Range("D1:D777").Replace "Е0501-63", "г05-01-63", xlPart Range("D1:D777").Replace "Е906-24", "г9-06-24", xlPart Range("D1:D777").Replace "Е0501-95", "Г05-01-95", xlPart Range("D1:D777").Replace "Е102-61", "Г1-02-61", xlPart Range("D1:D777").Replace "Е2601-", "г26-01-", xlPart Range("D1:D777").Replace "Е0102-61-", "г01-02-61-", xlPart Range("D1:D777").Replace "Е0801-", "г08-01-", xlPart Range("D1:D777").Replace "Е501-", "г05-01-", xlPart Range("D1:D777").Replace "Е402-", "г4-02-", xlPart Range("D1:D777").Replace "Е1303-", "г13-03-", xlPart Range("D1:D777").Replace "Е0903-", "г09-03-", xlPart Range("D1:D777").Replace "Е0701-", "г07-01-", xlPart Range("D1:D777").Replace "Е0601-", "г06-01-", xlPart Range("D1:D777").Replace "Е0904-", "г09-04-", xlPart Range("D1:D777").Replace "Е2707-", "г27-07-", xlPart Range("D1:D777").Replace "Е2709-", "г27-09-", xlPart Range("D1:D777").Replace "Е2701-", "г27-01-", xlPart Range("D1:D777").Replace "Е2702-", "г27-02-", xlPart Range("D1:D777").Replace "Е2703-", "г27-03-", xlPart Range("D1:D777").Replace "Е2704-", "г27-04-", xlPart Range("D1:D777").Replace "Е2705-", "г27-05-", xlPart Range("D1:D777").Replace "Е2706-", "г27-06-", xlPart Range("D1:D777").Replace "Е1306-", "г13-06-", xlPart Range("D1:D777").Replace "Е1305-", "г13-05-", xlPart Range("D1:D777").Replace "Е1304-", "г13-04-", xlPart Range("C1:C777").Replace "еноплекс", "еноплэкс", xlPart Range("C1:C777").Replace " . (", ".(", xlPart Range("C1:C777").Replace " (", "(", xlPart 'Минуса убрать с цены (минус из 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("H1").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6]&"""",'0'!R22C1:R3000C13,5,0)" 'nilem Range("H1:H" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-6]&"""",'0'!R22C1:R3000C13,5,0)" 'стоимость ПЗ в H Range("I1").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7]&"""",'0'!R22C1:R3000C13,6,0)" 'nilem Range("I1:I" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-7]&"""",'0'!R22C1:R3000C13,6,0)" 'стоимость ПЗ в I Range("J1").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8]&"""",'0'!R22C1:R3000C13,10,0)" 'nilem Range("J1:J" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-8]&"""",'0'!R22C1:R3000C13,10,0)" ' т/з в J 'стоимость материалов по формуле от bmv98rus Range("K1").Select ActiveCell.FormulaR1C1 = "=SUMPRODUCT(IFERROR(MID(SUBSTITUTE(RC[-3]&CHAR(10)&0,CHAR(10),REPT("" "",99)),{1,99},99)*{1,-1},))+IFERROR(-LEFTB(RC[-2],SEARCH(CHAR(10),RC[-3]&CHAR(10))-1),)" '_Boroda_ Range("K1:K" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=SUMPRODUCT(IFERROR(MID(SUBSTITUTE(RC[-3]&CHAR(10)&0,CHAR(10),REPT("" "",99)),{1,99},99)*{1,-1},))+IFERROR(-LEFTB(RC[-2],SEARCH(CHAR(10),RC[-3]&CHAR(10))-1),)" 'изменить ширину стоимости в куче Columns("H:I").Select Selection.ColumnWidth = 12 Range("P1").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-14]&"""",'0'!R22C1:R3000C13,4,0)" Range("P1:P" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-14]&"""",'0'!R22C1:R3000C13,4,0)" ' т/з из сметы замноженные на объём в P Range("O1").Select ActiveCell.FormulaR1C1 = "=IFERROR(MID(RC[-5],SEARCH(CHAR(10),RC[-5])+1,9)/RC[1],"""")" Range("O1:O" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=IFERROR(MID(RC[-5],SEARCH(CHAR(10),RC[-5])+1,9)/RC[1],"""")" ' т/з из сметы в O Range("N1").Select ActiveCell.FormulaR1C1 = "=IFERROR(LEFTB(RC[-4],SEARCH(CHAR(10),RC[-4])-1)/RC[2],"""")" Range("N1:N" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=IFERROR(LEFTB(RC[-4],SEARCH(CHAR(10),RC[-4])-1)/RC[2],"""")" ' т/з из сметы в N Columns("N:O").Select Selection.NumberFormat = "#,##0.00" 'объеденим материалы и т/з в M для примечания Range("M1").Select ActiveCell.FormulaR1C1 = "=RC[1]&"" ""&RC[2]&"" ""&RC[-2]" Range("M1:M" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=RC[1]&"" ""&RC[2]&"" ""&RC[-2]" ' поменять местами наименование и обоснование Columns("C:C").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Columns("E:E").Select Selection.Copy Columns("C:C").Select ActiveSheet.Paste Columns("E:E").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft 'СохрБезЗапроса Апострофф 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
[/vba] Предварительно: 1. выделите необходимый массив расценок(тело КС2). Только тело (столбцы с A по Н), без шапки и бороды. 2. переименовать лист со сметой в ноль "0".
нет нет только ноль (пустая ячейка) Спасибо. Ааааааааа это классно!!! Работает.
Надеюсь кому-нибудь пригодится в КС-2 форме с 8 графами (восьмиграфке) представить информацию о стоимости материальных ресурсов из расценок с работами, и при этом имея смету с 10-ти графами в неудобном двуэтажном виде, заключающем в одну ячейку несколько числовых значений (ПЗ и оплаты труда основных рабочих, Эксплуатации машин и в т.ч. оплаты труда, Трудозатр. осн. рабочих и Трудозатр. машинистов уже умноженные на весь сметный объём) [vba]
Код
Sub КС2_8_10двухэтажные() 'выделить предварительно массив! 'переименовать предварительно лист со сметой в "0" ! 'Отключение обновления экрана для ускорения работы макроса Application.ScreenUpdating = False Selection.SpecialCells(xlCellTypeVisible).Select Selection.Copy 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, 2) = "" Or Mid(Cells(i, 2), 1, 1) = "." Or Mid(Cells(i, 2), 1, 1) = Chr(133) Then Rows(i).Delete End If Next 'для всех D формула tt МВТ, Manyasha For Each cell In Range("d1:d" & Cells(Rows.Count, "d").End(xlUp).Row) cell.Value = tt(cell.Value) 'вызов UDF от МВТ Next cell 'переименовать, ибо отрывается буква от последующего слова Range("D1:D777").Replace "ГЭСН а", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН б", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН в", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН г", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН д", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН е", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН ж", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН з", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН и", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСНм и", "ГЭСНм", xlPart 'проверь Range("D1:D777").Replace "ГЭСН к", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН л", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН н", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН о", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН п", "ГЭСН", xlPart 'проверь Range("D1:D777").Replace "ГЭСН с", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН т", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН у", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН ф", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН х", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН ц", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН ч", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН ш", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН щ", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН ю", "ГЭСН", xlPart Range("D1:D777").Replace "ГЭСН я", "ГЭСН", xlPart Range("D1:D777").Replace "ФССЦ", "_______________", xlPart Range("D1:D777").Replace "СЦМ", "_______________", xlPart Range("D1:D777").Replace "ФСЦМ", "_______________", xlPart Range("D1:D777").Replace "С1", "_______________С1", xlPart Range("D1:D777").Replace "Т 1 - 1", "_______________", xlPart Range("D1:D777").Replace "Т 1-1", "_______________", xlPart Range("D1:D777").Replace "Е1303-4-17 К=2", "г13-03-04-17", xlPart Range("D1:D777").Replace "Е0905-2-1 изм.вып.1", "г09-05-002-1", xlPart Range("D1:D777").Replace "Е1303-4-5 К=2", "г13-03-4-5", xlPart Range("D1:D777").Replace "Е0501-117-1", "г05-01-117-1", xlPart Range("D1:D777").Replace "Е0906-24", "г09-06-24", xlPart Range("D1:D777").Replace "Е0501-63", "г05-01-63", xlPart Range("D1:D777").Replace "Е906-24", "г9-06-24", xlPart Range("D1:D777").Replace "Е0501-95", "Г05-01-95", xlPart Range("D1:D777").Replace "Е102-61", "Г1-02-61", xlPart Range("D1:D777").Replace "Е2601-", "г26-01-", xlPart Range("D1:D777").Replace "Е0102-61-", "г01-02-61-", xlPart Range("D1:D777").Replace "Е0801-", "г08-01-", xlPart Range("D1:D777").Replace "Е501-", "г05-01-", xlPart Range("D1:D777").Replace "Е402-", "г4-02-", xlPart Range("D1:D777").Replace "Е1303-", "г13-03-", xlPart Range("D1:D777").Replace "Е0903-", "г09-03-", xlPart Range("D1:D777").Replace "Е0701-", "г07-01-", xlPart Range("D1:D777").Replace "Е0601-", "г06-01-", xlPart Range("D1:D777").Replace "Е0904-", "г09-04-", xlPart Range("D1:D777").Replace "Е2707-", "г27-07-", xlPart Range("D1:D777").Replace "Е2709-", "г27-09-", xlPart Range("D1:D777").Replace "Е2701-", "г27-01-", xlPart Range("D1:D777").Replace "Е2702-", "г27-02-", xlPart Range("D1:D777").Replace "Е2703-", "г27-03-", xlPart Range("D1:D777").Replace "Е2704-", "г27-04-", xlPart Range("D1:D777").Replace "Е2705-", "г27-05-", xlPart Range("D1:D777").Replace "Е2706-", "г27-06-", xlPart Range("D1:D777").Replace "Е1306-", "г13-06-", xlPart Range("D1:D777").Replace "Е1305-", "г13-05-", xlPart Range("D1:D777").Replace "Е1304-", "г13-04-", xlPart Range("C1:C777").Replace "еноплекс", "еноплэкс", xlPart Range("C1:C777").Replace " . (", ".(", xlPart Range("C1:C777").Replace " (", "(", xlPart 'Минуса убрать с цены (минус из 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("H1").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-6]&"""",'0'!R22C1:R3000C13,5,0)" 'nilem Range("H1:H" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-6]&"""",'0'!R22C1:R3000C13,5,0)" 'стоимость ПЗ в H Range("I1").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-7]&"""",'0'!R22C1:R3000C13,6,0)" 'nilem Range("I1:I" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-7]&"""",'0'!R22C1:R3000C13,6,0)" 'стоимость ПЗ в I Range("J1").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-8]&"""",'0'!R22C1:R3000C13,10,0)" 'nilem Range("J1:J" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-8]&"""",'0'!R22C1:R3000C13,10,0)" ' т/з в J 'стоимость материалов по формуле от bmv98rus Range("K1").Select ActiveCell.FormulaR1C1 = "=SUMPRODUCT(IFERROR(MID(SUBSTITUTE(RC[-3]&CHAR(10)&0,CHAR(10),REPT("" "",99)),{1,99},99)*{1,-1},))+IFERROR(-LEFTB(RC[-2],SEARCH(CHAR(10),RC[-3]&CHAR(10))-1),)" '_Boroda_ Range("K1:K" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=SUMPRODUCT(IFERROR(MID(SUBSTITUTE(RC[-3]&CHAR(10)&0,CHAR(10),REPT("" "",99)),{1,99},99)*{1,-1},))+IFERROR(-LEFTB(RC[-2],SEARCH(CHAR(10),RC[-3]&CHAR(10))-1),)" 'изменить ширину стоимости в куче Columns("H:I").Select Selection.ColumnWidth = 12 Range("P1").Select ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-14]&"""",'0'!R22C1:R3000C13,4,0)" Range("P1:P" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=VLOOKUP(RC[-14]&"""",'0'!R22C1:R3000C13,4,0)" ' т/з из сметы замноженные на объём в P Range("O1").Select ActiveCell.FormulaR1C1 = "=IFERROR(MID(RC[-5],SEARCH(CHAR(10),RC[-5])+1,9)/RC[1],"""")" Range("O1:O" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=IFERROR(MID(RC[-5],SEARCH(CHAR(10),RC[-5])+1,9)/RC[1],"""")" ' т/з из сметы в O Range("N1").Select ActiveCell.FormulaR1C1 = "=IFERROR(LEFTB(RC[-4],SEARCH(CHAR(10),RC[-4])-1)/RC[2],"""")" Range("N1:N" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=IFERROR(LEFTB(RC[-4],SEARCH(CHAR(10),RC[-4])-1)/RC[2],"""")" ' т/з из сметы в N Columns("N:O").Select Selection.NumberFormat = "#,##0.00" 'объеденим материалы и т/з в M для примечания Range("M1").Select ActiveCell.FormulaR1C1 = "=RC[1]&"" ""&RC[2]&"" ""&RC[-2]" Range("M1:M" & Range("B" & Rows.Count).End(xlUp).Row).FormulaR1C1 = "=RC[1]&"" ""&RC[2]&"" ""&RC[-2]" ' поменять местами наименование и обоснование Columns("C:C").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Columns("E:E").Select Selection.Copy Columns("C:C").Select ActiveSheet.Paste Columns("E:E").Select Application.CutCopyMode = False Selection.Delete Shift:=xlToLeft 'СохрБезЗапроса Апострофф 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
[/vba] Предварительно: 1. выделите необходимый массив расценок(тело КС2). Только тело (столбцы с A по Н), без шапки и бороды. 2. переименовать лист со сметой в ноль "0".Yar4i
Это для загрузки в Гранд-Смету из Excel по столбцу M идёт примечание - благодаря чему мы сможем наглядно видеть трудозатраты и стоимость материалов, не раскрывая расценки ++ в программе и не терзая лишний раз смету. И про функцию tt забыл, что в теле кода основного. [vba]
Код
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
[/vba]
Это для загрузки в Гранд-Смету из Excel по столбцу M идёт примечание - благодаря чему мы сможем наглядно видеть трудозатраты и стоимость материалов, не раскрывая расценки ++ в программе и не терзая лишний раз смету. И про функцию tt забыл, что в теле кода основного. [vba]
Код
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
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
