Добрый день!
Нужно найти цену в колонке J по условию из колонки Е и проставить её в нужную ячейку в колоне К по условию из колонки D, при помощи формулы получается найти но только для одного варианта а таких вариантов много да и формулы очень тормозят рабочий файл.
Возможно ли это организовать при помощи VBA, у самого как то мозгов не хватает, прошу направить в нужное русло!

За ранее благодарю !

Здравствуйте!!
Нужна помощь что не так стало с кодом макроса сохранения файла при закрытии, в другой папке, до перехода на EXEL 2016 и Win10 всё прекрасно работало, сейчас же при закрытии файла макрос удаляет предыдущий файл из нужной папки и не записывает новый , при повторно открытии и закрытии файла, файл записывается.

Заранее благодарю!

Доброго времени суток всем !!!
Прошу помощи в доработке кода макроса ( найденного на форуме ) копирование листа без кода макроса в листе, нужно чтоб лист NETTING копировался сразу за собой и ему присваивалось новое имя дата и время, что то своими силами не получается

Заранее благодарю !

Всем доброго времени суток!
Может у кого есть макрос по удалению всех ячеек ( в столбце ) содержащих цифры со смещением вверх  
Что то при помощи поиска не могу найти ничего подходящего
С уважением

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

Доброго дня ! Подскажите пожалуйста что нужно подправить в макросе, чтоб скопированную информацию , начинал вставлять в перенесённом листе не со второй строки а например с десятой.
Заранее благодарю!
Private Sub CommandButton1_Click()
Dim li As Long, lLastRow As Long, sShName As String, avArr() As Long
Select Case True
Case OptionButton1: sShName = OptionButton1.Caption
Case OptionButton2: sShName = OptionButton2.Caption
Case OptionButton3: sShName = OptionButton3.Caption
End Select
If sShName = "" Then Exit Sub
Application.ScreenUpdating = 0
ReDim avArr(0)
With Sheets(sShName)
For li = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(li) Then
avArr(UBound(avArr)) = li + 2
ReDim Preserve avArr(UBound(avArr) + 1)
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
Rows(li + 2).Copy .Rows(lLastRow)
End If
Next li
End With
For li = UBound(avArr) To LBound(avArr) Step -1
If avArr(li) > 0 Then Rows(avArr(li)).Delete
Next li
Application.ScreenUpdating = 1
End Sub

макрос взят от сюда:
http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=8&TID=22585

Добрый вечер!    
Подскажите что нужно добавить в строку макроса    
Files = Dir(sFolder & "*" & Format(Date, "yymmdd") & "*.xls*")  
для поиска файла с датой(сегодня)в имени  
Пример названия файла   Export_settlement_positions_121114142829.xls  
правда как видно из имни там не только дата но и время, но может это можно как то игнорировать при поиске  
С уважением

Добрый день! Прошу помощи спецов по макросам  
Есть рабочий макрос смысл которого перенести информацию из EXCEL в рабочую программу,есть два варианта занести по одной или весь список,информация в ячейки попадает при помощи формул  
В чем проблема!!!надо чтоб если в ячейки нет значения макрос останавливался ,как я понимаю в один из циклов в макросе (наверноInputAllReports)проверяет пустая ячейка или нет, а там формула типа IF(Zhurnal!B5<>"",Zhurnal!B5,"")и получается что она пустая только визуально и макрос переносит пустые ячейки  
ниже код  
Const Description_Row = 2  
Const ValueMarks_Row = 3  
Const Fields_Row = 4  
Const Start_Row = 5  
Const GlobusApplication = "FT,ACPL"  
Const Start_Col = 2  
Const End_Col = 16  
Const ID_Col = 1  
Const GlbFunction = "COMMIT"  
Sub InputDeal(ByVal myrow As Long)  
 
If Not IsEmpty(Cells(myrow, ID_Col)) Then  
MsgBox ("ID is saved + " + Format(myrow))  
GoTo myexit  
End If  
 
Dim Desktop As Object  
 
Set Desktop = CreateObject("Desktop.Application")  
Set MYAPP = Desktop.getApplication(GlobusApplication)  
 
MYAPP.newid  
 
For i = Start_Col To End_Col  
  'If Cells(Fields_Row, i).Value <> "" Then  
     fieldname = Cells(Fields_Row, i).Value  
     If Cells(myrow, i).Value <> "" Then  
        MYAPP.Value(fieldname, Cells(ValueMarks_Row, i).Value) = Cells(myrow, i).Value  
     End If  
  'End If  
Next i  
 
Cells(myrow, ID_Col).Value = MYAPP.ID  
 
MYAPP.Commit  
myexit:  
End Sub  
Sub InputAllReports()  
   
 tekstr = Start_Row  
 Do While Not IsEmpty(Cells(tekstr, Start_Col))  
   InputDeal (tekstr)  
   tekstr = tekstr + 1  
 Loop  
 
End Sub  
Заранее благодарю

Добрый день! Помогите плз.,может у кого есть какой макрос переделывающий данные в числовой формат,а то приходится каждый раз дополнительные столбики к типо суммам F,H добавлять перемножать всё на 1,потом копируй,удаляй хочется как то автоматизировать а то данных часто бывает ну ооочень много.  
Заранее благодарю и хорошего дня!!!

Добрый день!  
При подсчёте данных использую формулу СУММПРОИЗВ (SUMPRODUCT)но в ячейки иногда выбирается не число,отсюда #value! формула не работает.Подскажите пожалуйста есть ли варианты решения данной проблемы(искал поиском ничего похожего не нашёл)  
Заранее благодарю.

Доброго дня Вам!  
Помогите с оброботкой даннйх из таблицы,смысл по определённым критериям разбить таблицу на несколько частей,диапазон таблиц не изменчив только по колонкам,может у кого есть макрос похожих сортировок,сами посебе таблицы давольно таки большые было бы здорово как то автоматизировать,искал на сайте что нибудь похожие не нашёл  
Зарание блогодарю!

Доброго дня Всем!  
Подскажите в чём проблема ,макрос в excel 2000 ругается на команду Sheets("RESULT").Copy After:=Sheets("COPY"), а в excel 2003 всё капируется на ура!Может что в настройах надо поменять?  
Зарание блогодарю!

Доброго дня!!!  
Подскажите пожалуйста есть ли в диапозоне ограничение на количество строк? до 7000 SUM(($H$3:$H$7000=$Q$3)*($I$3:$I$7000=P4)*$M$3:$M$7000)счетает,как ставишь больший диапозон перестаёт SUM(($H$3:$H$20000=$Q$3)*($I$3:$I$20000=P4)*$M$3:$M$20000) #VALUE!  
Может в настройках проблема?  
Заранее благодарю

Доброго вечера!  
Прошу помощи в решении проблемки,рабочая система импортирует в excel остатки в ввиде текста к примеру 143,921.37- ,можно ли при помощи какой нибудь формулы преобразовать в число -143,921.37  
Зарание благодарю

Доброго дня Вам!!  
Подскажите пожалуйста макрос чтоб в выбранные мною ячейки ,при его запуске,простовлялся определённый текст,допустим СПАСИБО.Ячейка может быть как одна так и несколько и находиться в разных столбцах.  
Заранее благодарю

Доброго дня Вам!  
Прошу помощи в решении одной проблемки,есть коротенький макрос    
Sub save() '  
OldName = ActiveWorkbook.FullName  
NovoeImjaFaila = "O:\COMMON.DIR\V.O.N.G\CASH\" & Replace(ActiveWorkbook.Name, ".xls", "") & "-" & [A1] & Format(Now, " DD MMMM YYYY HH-MM-SS") & ".xls"
ActiveWorkbook.SaveAs NovoeImjaFaila  
End Sub  
для преобразования файла шаблона в рабочий фаил с новым определённым названием!Смысл нажал на кнопку запуска макроса ОДИН РАЗ ,создал новый файлик и работаеш в нём,так вот беда умудряются по несколько раз нажимать на кнопку тем самим создовая новые ненужные файлы    
может есть возможность как то сделать что макрос запускается только один раз или при повторном нажатии появится предупреждение о том что макрос уже своё дело один раз сделал!

Доврого дня Вам!  
Помогите пожалуйста обьеденить два макроса в один,что то никак не получается,первий добовляет новую инфу в выподающийи список  
Private Sub Worksheet_Change(ByVal Target As Range)  
   Dim lReply As Long, lLastRow As Long  
   If Target.Cells.Count > 1 Then Exit Sub  
   If Target = "" Then Exit Sub  
   If Intersect(Range("D:H"), Target) Is Nothing Then Exit Sub  
     
   With Sheets("DATA")  
       lLastRow = .Cells(Rows.Count, Target.Column - 3).End(xlUp).Row  
       If Application.WorksheetFunction.CountIf(.Range(.Cells(2, Target.Column - 3), .Cells(lLastRow, Target.Column - 3)), Target) = 0 Then  
           lReply = MsgBox("Add item " & _  
                           Target & " in ValidationList?", vbYesNo + vbQuestion)  
           If lReply = vbYes Then  
               Application.EnableEvents = False  
               .Cells(lLastRow + 1, Target.Column - 3) = Target  
               .Range(.Cells(2, Target.Column - 3), .Cells(lLastRow + 1, Target.Column - 3)).Sort .Cells(2, Target.Column - 3)  
               Application.EnableEvents = True  
           End If  
       End If  
   End With  
End Sub  
а второй проставляет дату при заполнении ячейки  
Private Sub Worksheet_Change(ByVal Target As Range)  
If Target.Cells.Count > 1 Then Exit Sub  
If Not Intersect(Target, Range("B2:B10000")) Is Nothing Then  
With Target(1, 0)  
.Value = Now  
End With  
End If  
If IsEmpty(Target) Then  
Target(1, 0) = Empty  
End If  
End Sub  
понятнто что два олдинаковых Private Sub Worksheet_Change(ByVal Target As Range) а вот объеденить не получается!!!

Доброго вечера Вам!  
Подскажите пожалуйста что неправельно в этой команде  ActiveSheet.Name After:=Sheets("RIG")или как её заменить,смысл действия,нужно открыть(активизировать)лист стоящий рядом с листом RIG  
Заранее благодарю!

Доброго дня Вам!  
Прошу помощи,незнаю как оптимизировать процес сравнения.Есть выборка по счетам на разных листах,по названию счёта и его окончанию нужно найти и проверить сумму остатка совпадают или нет(причем противоположная сумма,должна быть с противоположным знаком)проблема в том что одни счета находится на одном листе,другие на другом и т.д.,в файле более понятней видно ситуацию.  
Заодно может кто подскажет ,что нужно добавить в страку макрос,чтоб удолялись не только строки с ''0'' но и с пустой ячейкой If Application.Rows®.Columns(6).Value = "0" Then Rows®.Delete  
Заранее блогодарю

Доброго дня Вам!  
Подскажите как решить проблемку.Есть формула результат которой сумма(лист МТ210 колонка Е),при наличии десятичных они соответственно отделены точкой,но ввиду производственной необходимости нужно заменить точку на запятую для последующего копирования етой сууммы с буфера обмена,использую способ copy-pastevalues-repleace.Но может есть способ замены при помощи формулы?

Доброго дня Вам!  
Есть макрос по удалению строк по критерию  
Sub DeleteEmptyRowsColumns()  
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count  
Application.ScreenUpdating = False  
For r = LastRow To 1 Step -1  
If Application.Rows®.Columns(12).Value = "0" Then Rows®.Delete  
Next r  
End Sub  
пытаюсь заменить Columns(12) на Range("L71:L310")так как нужно не повсей колонке выберать а только с L71 по L310 ,но макрос ругается н и соответственно не работает!  
Подскажите что не так?

Доброго дня Вам!  
Объясните пожалуйста в чём разница.копирую информацию из ячейки и пытаюсь вставить её в другую программу не EXCEL  
не получается а если копировать из строки формул всё вставляется.Может можно как то это исправить?  
постоянно копировать из строки формул не подходит ячейка не одна  
С Уважением

Доброго дня Вам!!  
Подскажите пожалуйста какой формулой можно расчитать среднее количество(коэф.)сотрудников на работе за месяц.  
Попробую щбъеснить,всё ето нужно для вычесления нагрузки на одного человека в месяц,допустим в месяце 22 раб.дня, в отделе 5 человек один из сотрудников отсутствовал 16 дней, другой 5 ,отсюда вывод ,ну никак небыло на работе постоянно 5 человек и общее количество сделок поделить на 5 не будет правелным

Доброго вечера Вам!    
Есть часть макроса которая исчет нужный текст в столбце  
strDefaultPrinter = Application.ActivePrinter  
     
   Set rEOF = Range("a1:A500").Find("* ***THIS account", LookIn:=xlValues)  
   If rEOF Is Nothing Then  
       MsgBox "Invalid page format", vbExclamation  
       Exit Sub  
   End If  
что нужно сюда добавить чтоб помимо выше упомянутой функции ещё и контролировалось заполнение ячейки C11 , и ругался MsgBox что она незаполнена

Доброго дня Вам!!!    
Есть фаил с выпадающими списками в нём макрос для выпадающих списков с добавлением новых элементов,но внём что то не так,зараза не хочет работать,несколько раз прочитан прием для выпадающего списка http://www.planetaexcel.ru/tip.php?aid=98,и для одного списка макрос из описания работает прекрасно а вот как зделать макрос для нескольких списков  чтоб новые элементы добавлялись каждый в свой список

Доброго дня Вам!  
Подскажите что нужно перенастроить в VBA чтоб шрифт кириллицы работал, а то вместо нормальных букв,ставится знак ''?''

Доброго дня Вам  
Есть макрос для отправки листа по имейлу  
Sub SendSheet()  
ThisWorkbook.Sheets("send").Copy  
With ActiveWorkbook  
.SendMail Recipients:="NS@PAX.EU", _  
Subject:="PAY"  
.Close SaveChanges:=False  
End With  
End Sub  
1.В лист вся инфо вытягивается при помочи формул,что необходино добавит в макрос,чтоб в отправленном листе этих формул небыло видно,что то вроде paste special values или можно отправит как картинку  
2.И можно ли сюда что то добавит чтоб отсылаевому фаилу присваивалос имя тои книги откуда етот лист берется

Доброго дня Всем!    
Подскажите можно ли вывести сочетание клавиш на кнопку,чтоб при её нажатии срабатывало допустим сочетание кнопок Win + B

Доброго дня Всем!  
Есть формула примерно такая IF(H1>0;ок;" ")в H1 находится другая формула, и не воспринемает её как 0-е значение,ето можно как то устранить?  
В файлике образец проблемки

Доброго дня Вам!  
Помогите разобратся,есть макрос,смысл которого открывать файлы в одной из папок,и автоматически сейвить в другую приклеивая к старому имени  дату  
Function Open_XL_File() As String  
m2: Filename = Application.GetOpenFilename(FileFilter:="Microsoft Excel Files (*.xls), *.xls", _  
MultiSelect:=False, Title:="Izvēlieties failu")  
msg = "Jums nav izvēlieties failu! Turpināt?"  
 
If VarType(Filename) = vbBoolean Then  
Select Case MsgBox(msg, 52, Application.Name)  
Case 6: GoTo m2  
Case 7: Exit Function  
End Select  
End If  
 
Set oWbook = Workbooks.Open(Filename)  
Open_XL_File = oWbook.Name  
End Function  
 
Sub test() '  
ChDrive "O:"  
ChDir "O:\COMMON.DIR\V.O.N.G\PAM_Zhurnal\new"  
file1 = Open_XL_File  
Debug.Print "Otkriti faili: ", file1  
OldName = ActiveWorkbook.FullName  
NovoeImjaFaila = "O:\COMMON.DIR\V.O.N.G\PAM_Zhurnal\done\" & Replace(ActiveWorkbook.Name, ".xls", "") & Format(Now, " - DD MMMM YYYY HH-MM-SS ") & ".xls"  
ActiveWorkbook.SaveAs NovoeImjaFaila  
Kill OldName  
End Sub  
 
так вот всё хорошо работало на всех компах,но в один "прекрасный" момент на компах с EXCEL более ранних выпусков (1998 или 2000)макрос стал ругатся на функцию Repleace в строке NovoeImjaFaila,ето возможно как-то вылечить? и почему раньше работало а сечас перестало