Добрый всем день!
Подскажите с реализацией задачи, есть столбец с данными:
Возм 6232 (какой-то текст с цифрами всегда разный) и в конце K.132.56
Какой-то текст с цифрами
Какой-то текст с цифрами
Возм 6232 (какой-то текст с цифрами всегда разный) и в конце K.102.03
Какой-то текст с цифрами
Возм 6232 (какой-то текст с цифрами всегда разный) и в конце K.92.31
И так далее чередуется в произвольном порядке.

К. и цифры это размер комиссии.
Задача просуммировать комиссии по всему столбцу.
Как получить комиссию из конкретной ячейки, заменить точку на запятую и преобразовать текст в число я сделал:
=ЗНАЧЕН(ПОДСТАВИТЬ(ПСТР(D13;НАЙТИ("К.";D13)+2;20);".";",";1))
А вот как теперь отобрать строки которые начинаются с "Возм 6232" и просуммировать эти комиссии?
Надо по идее формулой массива, но что-то я так и не смог справиться.
Пример во вложении.

Подскажите пожалуйста, что-то поиском ничего не нашёл, возможно ли скопировать выделенный цветом текст из ячеек в другой столбец, текст выделен частично, т.е.:
в ячейке А1 есть текст: "взвейтесь кострами синие ночи", нужно в ячейку B1 скопировать текст: "кострами синие". И так для всего диапазона например с А1 до А100.

Пару лет назад уважаемый anvg сделал макрос по заливке фигур по значениям в ячейках вот в этой теме: ссылка
Я пытаюсь адаптировать этот код под свои нужды, у меня всё реализовано на одном листе и никак не могу добиться его работы, ошибку выдаёт на строке:
Подскажите кудать копать, файл прилагаю.

Вот в этой теме Моя тема о проблеме поиска я описывал проблему с поиском и заменой с которой я столкнулся. А тут методом проб и ошибок выяснил, что проблемы эти начинаются сразу после того как воспользоваться любой функцией из раздела "Текст" надстройки Plex. Т.е. после любых манипуляций с текстом из надстройки прекращает работать поиск и замена, пока не закроешь полностью Excel и не откроешь его заново. Хотелось бы как то это исправить.

Подскажите кто-нибудь если сталкивались. Почему-то вдруг перестала работать функция поиск и замена. На любой поиск и замену пишет данные не найдены. Галочка на искать ячейку целиком не стоит. Я уже всю голову сломал, а работать без неё не возможно.
Офис 2013.

Добрый день всем!
Тут понадобилось создать шаблон презентации в PowerPoint. Помимо всего прочего для единообразия его дальнейшего использования есть необходимость ограничить пользователей в выборе шрифта и цветов для оформления. В стандартных настройках такого не нашёл. Но ведь есть же макросы. Никто не подскажет как макросом сделать такие ограничения?

Добрый день!
Подскажите как можно макросом вставить такое количество строк, которое определяется значением переменной со сдвигом вниз.
Просто выделить и вставить как-то так:
   Rows("6:14").Select
   Selection.Insert Shift:=xlDown

А если надо вставить x строк?
Значение переменной определяется другим кодом.

Добрый день!
Подскажите решение такой проблемы, в прилагаемом файле создана форма для введения и редактирования курсов валют через форму.
Меня интересует поле для ввода курса валюты. В макросе приведён код контролирующий ввод только цифр с двумя знаками после запятой, для этого есть переменная DECPLACES, которой присвоено значение соответственно 2. Мне надо сделать, чтобы после запятой было 4 знака.
Я меняю значение DECPLACES на 4 и получается ерунда, разделить вообще убирается.

Помогите создать макрос для создания выпадающего списка макросом в ячейке H5 без пустых строк. Значения берутся из именованного диапазона "FIL", но в нём могут быть пустые ячейки, соответственно хотелось бы, чтобы они не добавлялись в выпадающий список.
Код как-то так, но выдаёт ошибку на третьей строке.

Подскажите пожалуйста, после перехода на Excel 2013 отказался работать прогресс бар, выдаёт сообщение could not load an object because it is not available on this machine и прогресс бар из формы удаляется. Насколько я понимаю не хватает какой-то библиотеки, по аналогии с календарём, но вот какой именно и где её можно взять. Или я вообще ошибаюсь в причине неполадки?

Подскажите, пожалуйста, как поменять код ниже, чтобы он работал и на 32, и на 64 битах.:

Подскажите пожалуйста каким образом можно макросом вставить в ячейку гиперссылку на конкретную папку.
Чтобы при запуске макроса открывылось окно с просьбой указать саму папку.
Запись макрорекордем мне ясности не придала.
Спасибо заранее.

Помогите получить данные из исходных данных в итоговую таблицу по дате.
Для тип2 я применил формулу ГПР, т.к. данные в одном столбце с датой, а для тип3 не понимаю как написать, т.к. данные в соседнем столбце с датой.
Пояснения в примере.
Спасибо заранее.

Ткните носом если такая тема уже была.
Никак не могу сообразить как посчитать количество заполненных ячеек в последнем заполенном столбце диапазона.
Нашёл формулу массива, которая выдаёт номер последнего заполненного столбца:
{=МАКС(СТОЛБЕЦ($D$1:$DC$20)*НЕ(ЕПУСТО($D$1:$DC$20)))}
Теперь не могу сообразить как применить этот номер в формуле:
=СЧЁТЗ(R1C[номер столбца из формулы выше]:R20C[номер столбца из формулы выше])
Спасибо заранее.

Добрый день!
Помогите мне пожалуйста с таким вопросом.
Я пытаюсь в макросе добавить в комбобокс месяца года, но не все, а с проверкой по условию.

Пишет:
Run time error 13
type mismatch.
Что я делаю не так?

Всем доброго дня. У меня есть макрос, который строит диаграмму по той строке, в которую ставим курсор.
Я попытался переделать этот макрос для построения графиков, но для несвязанных диапазонов, но у меня ничего не получается. Я даже записываю макрорекордером создание такой диаграммы, потом запускаю получившийся макрос, а он также отказывается работать. Файл прилагаю.

Доброе утро Всем!  
Подскажите мне по такому вопросу: я макросом ставлю защиту на все листы в книге:  
   Dim WkSht As Worksheet  
   For Each WkSht In Worksheets  
       WkSht.Protect Password:=PWORD, UserInterfaceOnly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True _  
           , AllowFormattingCells:=True, AllowFormattingColumns:=True, _  
           AllowFormattingRows:=True  
   Next WkSht  
А как мне также на всех листах запретить работу функции "вырезать"? Чтобы копировать и вставлять можно было, а вырезать нет.

Уважаемые гуру подскажите, почему не работает формула в жёлтой ячейке, файл прилагаю.

Уважаемые знатоки подскажите, как формулой просуммировать значения ячеек столбца таблицы с данными в имени которого (т.е. в значении ячейки 1 строки) у такого столбца есть слово "Сумма", если такой столбец только один в этой таблице. Это нужно т.к. столбец каждый раз может быть в разных местах.

Добрый день!  
Подскажите пожалуйста, в документе реализована функция фильтрации данных через макрос.  
На листе есть кнопка, по нажатию на неё открывается форма предлагающая ввести текст для фильтрации. Далее макрос ищет строки в которых есть введённый текст и скрывает строки в которых он не найден. Макрос работает так как надо, кроме скорости. При наличии 300 строк макрос обрабатывает их где-то секунд 15, а при большем и того больше.  
Вопрос, можно ли как-то ускорить работу макроса:  
Private Sub OK_Click()  
   Application.ScreenUpdating = False  
   Application.EnableEvents = False  
Dim iRange As Range  
Dim lFifstRow As Long  
Dim iFifstColumn As Integer  
lFifstRow = Range("A2:F1000").Row  
iFifstColumn = Range("A2:F1000").Column  
lLastRow = Range("A2:F1000").Rows.Count + 3  
iLastColumn = Range("A2:F1000").Columns.Count  
Set iRange = Range(Cells(lFifstRow, iFifstColumn), Cells(lLastRow, iLastColumn))  
       Range("A2:F300").EntireRow.Hidden = False  
   With iRange  
       Set ifoundRng = .Cells.Find(What:="Текст для поиска", LookIn:=xlFormulas, LookAt:=xlPart)  
       Range(iRange.Address).EntireRow.Hidden = True  
       If Not ifoundRng Is Nothing Then  
           firstAddress = ifoundRng.Address  
       Do  
           Rows(ifoundRng.Row).Hidden = False  
           Set ifoundRng = .Cells.FindNext(ifoundRng)  
       Loop Until ifoundRng.Address = firstAddress  
       Else  
           MsgBox "Значение на листе не найдено!", vbExclamation, "Ошибка"  
           GoTo Exit_  
       End If  
   End With  
Exit_:  
   End If  
       Application.ScreenUpdating = True  
       Application.EnableEvents = True  
   Unload Me  
End Sub

Подскажите, можно ли при открытии файла по гиперссылке в файле, которую я вставляю в макросе (ThisBook.Hyperlinks.Add Anchor:=ThisBook.Cells(Selection.Row, 5), Address:=filetoopen) - открывать файл с условием только на чтение?

Доброго всем дня!  
Подскажите, мне макросом из исходного файла надо открыть другой файл, найти в открытом файле ячейку, в которой находится текст "Статус клиента", далее присвоить переменной d1 значение ячейки, находящейся справа от ячейки с текстом "Статус клиента". И вставить это значение в исходный файл.  
 
Макрос файл открывает, далее я сделал такой код поиска:  
   Set d1 = Sheets(1).Cells.Find("Статус клиента", , xlValues, xlWhole).Value  
Но он копирует значение самой ячейки, а как скопировать значение ячейки справа от искомой?

Подскажите, может есть готовое решение корректного расчёта выполнения факта по сравнению с планом в процентах выполнения. Может быть девять вариантов данных:  
1. План > 0, Факт > 0  
2. План < 0, Факт > 0  
3. План < 0, Факт < 0  
4. План > 0, Факт < 0  
5. План = 0, Факт > 0  
6. План = 0, Факт < 0  
7. План > 0, Факт = 0  
8. План < 0, Факт = 0  
9. План = 0, Факт = 0

Подскажите, у меня был код по добавлению значений в ComboBox из именованного диапазона с одного листа:  
       Set rng0 = Range("Диапазон")  
   For Each cl In rng0.Cells  
       Tip.AddItem (cl.Value)  
   Next  
А теперь понадобилось добавить в этот же ComboBox ещё значения из другого именованного диапазона с другого листа, я сделал так:  
       Set rng01 = Range("Диапазон1") ' на листе1  
       Set rng02 = Range("Диапазон2") ' на листе2  
       Set rng0 = Union(rng01, rng02)  
   For Each cl In rng0.Cells  
       Tip.AddItem (cl.Value)  
   Next  
но код не работает, подскажите что не так и можно ли такое сделать вообще?

Подскажите пожалуйста, вставляю в ячейки именованного диапазона Fakt значения из контролов формы. На всех компьютерах всё работает как часы, но на одном почему-то числа вставляются как текст с пробелами в качестве разделителя разрядов, не пойму почему.  
Код ниже:    
DECSEP = Application.International(xlDecimalSeparator)  ' <== дес. разделитель: запятая или точка  
Dim rCell As Range  
For Each rCell In Range("Fakt")  
i = i + 1  
rCell = Format(Me.Controls("Dannye" & i), "[$?-2] #" & DECSEP & "##0")
Next rCell

Может уже было, но поиском не нашёл. Пытаюсь написать макрос копирования всех именованных диапазонов и именованных формул из открываемого файла в текущий (открытый).  
Но что-то моих знаний не хватает.  
Привожу текст макроса и файл с ним во вложении.  
 
Sub CopyName()  
       Application.ScreenUpdating = False  
       Application.EnableEvents = False  
   Set ThisBook = ActiveSheet  
       filetoopen = Application.GetOpenFilename("Файлы Microsoft Office Excel, *.xls")  
   If filetoopen = False Then  
       End  
   End If  
   Set OpenFile = Workbooks.Open(filetoopen)  
       ThisBook.Unprotect Password:="123"  
       ThisBook.Activate  
 
   Dim iName As Name  
       For Each iName In OpenFile.Names  
           ThisBook.Names.Add iName.Name, iName.RefersTo  
   Next iName  
 
   ThisBook.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:=True _  
   , AllowFormattingCells:=True, AllowFormattingColumns:=True, _  
   AllowFormattingRows:=True  
   OpenFile.Close SaveChanges:=False  
       Application.ScreenUpdating = True  
       Application.EnableEvents = True  
End Sub

Добрый день всем знатокам!  
Подскажите нет ли формулы в Excel для подсчёта парето, т.е. из массива данных с оборотом по клиентам, а надо посчитать кол-во клиентов принёсших 80% от общего оборота.

Поиском не смог найти, в макросе для сохранения в формате 2003 экселя задаю:  
.GetSaveAsFilename("Имя файла", "Файлы Microsoft Office Excel, *.xls")  
А как задать для сохранения в формате *.xlsx, как я только уже не пробовал, сохраняет, но потом нельзя открыть.  
 
The Prist писал:  
xlNormal и xlExcel8 - это 2003 Excel(числовая константа - 50 - если не изменяет память)  
Для 2007 можно и числовыми константами - 51(обычный xlsx) и 52(с поддержкой макрсоов xlsm).  
 
Но если честно не понял как это применить.

Добрый день!  
Подскажите пожалуйста с решением такой задачи. Поиском находил, нечто подобное, но под себя не в состоянии адаптировать.  
Есть несколько файлов в которых находятся базы данных, в каждом файле есть столбец контрагент (столбец может быть на разных местах). Мне необходимо через макрос в новом файле (который находится в другой папке) собрать данные из этого столбца в один столбец и удалить дубликаты.  
Здесь где-то попадался такой код объединения всех данных с листов, вот если бы его поправить только до одного столбца:  
 
Sub Объединение_множества_книг_в_один_лист()  
Const strStartDir = "c:\test" 'папка, с которой начать обзор файлов  
Const strSaveDir = "c:\test\result" 'папка, в которую будет предложено сохранить результат  
Const blInsertNames = False 'вставлять строку заголовка (книга, лист) перед содержимым листа  
Dim wbTarget As New Workbook, wbSrc As Workbook, shSrc As Worksheet, shTarget As Worksheet, arFiles, _  
i As Integer, stbar As Boolean, clTarget As Range  
On Error Resume Next 'если указанный путь не существует, обзор начнется с пути по умолчанию  
ChDir strStartDir  
On Error GoTo 0  
With Application 'меньше писанины  
arFiles = .GetOpenFilename("Excel Files (*.xls), *.xls", , "Объединить файлы", , True)  
If Not IsArray(arFiles) Then End 'если не выбрано ни одного файла  
Set wbTarget = Workbooks.Add(template:=xlWorksheet)  
Set shTarget = wbTarget.Sheets(1)  
.ScreenUpdating = False  
stbar = .DisplayStatusBar  
.DisplayStatusBar = True  
For i = 1 To UBound(arFiles)  
.StatusBar = "Обработка файла " & i & " из " & UBound(arFiles)  
Set wbSrc = Workbooks.Open(arFiles(i), ReadOnly:=True)  
For Each shSrc In wbSrc.Worksheets  
If IsNull(shSrc.UsedRange.Text) Then 'лист не пустой  
Set clTarget = shTarget.Range("A1").Offset(shTarget.Range("A1").SpecialCells(xlCellTypeLastCell).Row, 0)  
If blInsertNames Then  
clTarget = ">>> " & wbSrc.Name & " -- " & shSrc.Name  
Set clTarget = clTarget.Offset(1, 0)  
End If  
shSrc.UsedRange.Copy clTarget  
End If  
Next  
wbSrc.Close False 'закрыть без запроса на сохранение  
Next  
.ScreenUpdating = True  
.DisplayStatusBar = stbar  
.StatusBar = False  
On Error Resume Next 'если указанный путь не существует и его не удается создать,  
'обзор начнется с последней использованной папки  
If Dir(strSaveDir, vbDirectory) = Empty Then MkDir strSaveDir  
ChDir strSaveDir  
On Error GoTo 0  
arFiles = .GetSaveAsFilename("Результат", "Excel Files (*.xls), *.xls", , "Сохранить объединенную книгу")  
If VarType(arFiles) = vbBoolean Then 'если не выбрано имя  
GoTo save_err  
Else  
On Error GoTo save_err  
wbTarget.SaveAs arFiles  
End If  
End  
save_err:  
MsgBox "Книга не сохранена!", vbCritical  
End With  
End Sub  
 
И еще добавить удаление дубликатов, тоже что-то где-то здесь попадалось (Pavel55 для Анюты делал):  
       'удаляем одинаковые строки в таблице (дубли)  
       Dim iRow As Long 'номер начального ряда  
       Dim iRow2 As Long 'номер проверяемого ряда  
       iLastRowBazaA = Cells(Rows.Count, 1).End(xlUp).Row  
       iLastRowBazaB = Cells(Rows.Count, 2).End(xlUp).Row  
       iLastRowBazaA = IIf(iLastRowBazaA >= iLastRowBazaB, iLastRowBazaA, iLastRowBazaB)  
       iDubli = 0  
       For iRow = iLastRowBazaA To 2 Step -1  
           For iRow2 = iRow - 1 To 2 Step -1  
               If Evaluate("AND(A" & iRow & ":Y" & iRow & "=A" & iRow2 & ":Y" & iRow2 & ")") = True Then  
                   'если строки одинаковые  
                   Rows(iRow2).EntireRow.Delete  
                   iDubli = iDubli + 1  
                   iRow = iRow - 1  
                   iLastRowBazaA = iLastRowBazaA - 1  
               End If  
           Next iRow2  
       Next iRow

Добрый день!  
Когда-то здесь на форуме мне помогли создать выпадающий список на форме из установленных на компьютере принтеров. Было это сделано вот таким кодом:  
Const PRINTERS_AND_FAXES = &H4&  
Set objShell = CreateObject("Shell.Application")  
Set objFolder = objShell.Namespace(PRINTERS_AND_FAXES)  
Set objFolderItem = objFolder.Self  
Set colItems = objFolder.Items  
For Each objItem In colItems  
Printers.AddItem objItem.Path  
Next  
 
Файл использовался долго на разных машинах в наших филиалах, но тут сегодня выяснил, что на паре компьютеров форма отказывется открываться, выдавая сообщение Run-time error 91. Object variable or With block variable not set. Операционка везде Windows XP, принтеры на компьютере установлены и сетевой и локальный, но ошибка вываливается.  
Понимаю, что трудно предположить причину возникновения, но вдруг кто-то сталкивался.  
Может какую-то защиту от ошибок в макрос добавить?