Выбрать дату в календареВыбрать дату в календаре

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

За ранее благодарю !
Макрос сохранения файла при закрытии, в другой папке, Макрос сохранения файла при закрытии, в другой папке перестал корректно работать
 
Разобрался, заменил код и всё заработало
Код
ActiveWorkbook.SaveAs Filename:=FileNameXls, _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Макрос сохранения файла при закрытии, в другой папке, Макрос сохранения файла при закрытии, в другой папке перестал корректно работать
 
Здравствуйте!!
Нужна помощь что не так стало с кодом макроса сохранения файла при закрытии, в другой папке, до перехода на EXEL 2016 и Win10 всё прекрасно работало, сейчас же при закрытии файла макрос удаляет предыдущий файл из нужной папки и не записывает новый , при повторно открытии и закрытии файла, файл записывается.

Заранее благодарю!
Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim x As String
strPath = "\\Cn4-opdir-server\opdir\Groups\ROL-INV\COMMON.DIR\BACK OFFICE"
On Error Resume Next
x = GetAttr(strPath) And 0
If Err = 0 Then ' еспн ўуть существует - сџхЇаљяер оџўню ољнгн
Application.DisplayAlerts = False
FileNameXls = strPath & "\" & Left(ActiveWorkbook.Name, _
Len(ActiveWorkbook.Name) - 4) & "xlsm"
ActiveWorkbook.SaveCopyAs Filename:=FileNameXls
Application.DisplayAlerts = True
Else 'еспн ўуть ље существует - вывџднр сџџбщељне
MsgBox "Papka " & strPath & " nedostupna ili ne suchestvuet!", vbCritical
End If
End Sub

Макрос копирование листа без кода макроса
 
The_Prist, Спасибо, буду теперь более внимательным
Изменено: Николай Сергеев - 09.06.2016 13:40:32
Макрос копирование листа без кода макроса
 
The_Prist, Да я с радостью, только я не такой продвинутый форумчанин , например "оформите код тегами" меня поставил в тупик :(  пойду гуглить
Макрос копирование листа без кода макроса
 
vikttur, Можно по буквам что я должен сделать ? Что то я не понял :(
Макрос копирование листа без кода макроса
 
Код
Dim sh As Worksheet
Sub COPYLIST3()
Dim sh As Worksheet
Set sh = Sheets("NETTING")
Sheets.Add after:=sh 'вставляем новый лист после копируем
sh.Cells.Copy Destination:=Sheets(Sheets("NETTING").Index + 1).Cells
Set sh = Sheets(Sheets("NETTING").Index + 1)
sh.Name = "NETT " & Format(Now, "dd_mm_yyyy-hh_ss") 'Новое имя + дата и время создания
End Sub
Спасибо The Prist
Всё работает!
Хорошего дня
Изменено: Николай Сергеев - 09.06.2016 13:39:09
Макрос копирование листа без кода макроса
 
проблема осталась лист копируется без данных
Изменено: Николай Сергеев - 11.06.2016 23:59:48
Макрос копирование листа без кода макроса
 
Добрый день The Prist
Код
Sheets.Add after:=sh
почему то лист копируется пустой без данных а на
Код
Sheets("NETTING (2)").Name = Format(Now, " DD MMMM YYYY HH-MM-SS")
выдаёт за ошибку  
Изменено: Николай Сергеев - 09.06.2016 13:22:04
Макрос копирование листа без кода макроса
 
Доброго времени суток всем !!!
Прошу помощи в доработке кода макроса ( найденного на форуме ) копирование листа без кода макроса в листе, нужно чтоб лист NETTING копировался сразу за собой и ему присваивалось новое имя дата и время, что то своими силами не получается :(
Код
Sub COPYLIST2()
Dim sh As Worksheet
Set sh = Sheets("NETTING")
Sheets.Add after:=Sheets(Sheets.Count)
sh.Cells.Copy Destination:=Sheets(Sheets.Count).Cells
End Sub

Заранее благодарю !
Удаление ячеек по критерию при помощи VBA
 
Спасибо!!!
Хорошего дня!!
Удаление ячеек по критерию при помощи VBA
 
Только ячейку со смещениием вверх
Удаление ячеек по критерию при помощи VBA
 
Всем доброго времени суток!
Может у кого есть макрос по удалению всех ячеек ( в столбце ) содержащих цифры со смещением вверх  
Что то при помощи поиска не могу найти ничего подходящего
С уважением
Поиск в ячейке справа налево
 
Спасибо!! оба варианта подходят!! будим учиться
Хорошего дня!!!
Поиск в ячейке справа налево
 
Добрый день! Прошу помощи в составлении формулы, нужно выбрать весть текст из ячейки после самого последнего слова "FOR" их в тексте может быть несколько, может можно как то начать поиск справа налево, чтоб это слово стало первым.
Перенос данных и автоматическое обновление ListBox, правка макрос переноса данных
 
ругается Next without for
Перенос данных и автоматическое обновление ListBox, правка макрос переноса данных
 
не ,не подходит, при таком раскладе lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 8 он конечно начинает вставлять с 9 строки но к сожалению все последующие скопированные строки вставляет с промежутком в 7 строк а надо чтоб шли подряд
Перенос данных и автоматическое обновление ListBox, правка макрос переноса данных
 
Доброго дня ! Подскажите пожалуйста что нужно подправить в макросе, чтоб скопированную информацию , начинал вставлять в перенесённом листе не со второй строки а например с десятой.
Заранее благодарю!
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
Поиск файла с датой в имени
 
во как! спасибо Слэн!!! не убрал с копируемого примера определение sfolder    
теперь всё работает  
sFiles = Dir("*" & Format(Date, "yymmdd") & "*.xls*")  
   Do While sFiles <> ""  
       'otkrivaem  
       Workbooks.Open sFiles  
Спасибо огромное!!  
Хорошего дня!!!!
Поиск файла с датой в имени
 
с кодом sFiles = Dir(sFolder & "*Export*.xls*") всё прекрасно работает , но нужно зацепиться за дату в имени файла а вот ето не получаеться
Поиск файла с датой в имени
 
А я правелно проставил???? sFiles = Files Like Dir(sFolder & "*" & Format(Date, "yymmdd") & "*.xls*")
Поиск файла с датой в имени
 
нет,не хочет работать
Поиск файла с датой в имени
 
ноль эмоций, не находит :(
Поиск файла с датой в имени
 
Добрый вечер!    
Подскажите что нужно добавить в строку макроса    
Files = Dir(sFolder & "*" & Format(Date, "yymmdd") & "*.xls*")  
для поиска файла с датой(сегодня)в имени  
Пример названия файла   Export_settlement_positions_121114142829.xls  
правда как видно из имни там не только дата но и время, но может это можно как то игнорировать при поиске  
С уважением
Подправить макрос
 
{quote}{login=Hugo}{date=02.11.2011 11:25}{thema=}{post}Нет такой формулы, и быть не может.  
Так попробуйте:  
 
Do While Len(Cells(tekstr, Start_Col)){/post}{/quote}  
Спасибо HUGO ,помогло!! Хорошего дня!!
Подправить макрос
 
может есть какая формула,делающая ячейку пустой
Подправить макрос
 
{quote}{login=RAN}{date=01.11.2011 06:47}{thema=}{post}Попробуйте  
If Cells(tekstr, Start_Col).HasFormula = False Then  
(с вариациями){/post}{/quote}  
что то без изменений
Подправить макрос
 
Добрый день! Прошу помощи спецов по макросам  
Есть рабочий макрос смысл которого перенести информацию из 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  
Заранее благодарю
преобразовать данные в числовой формат
 
{quote}{login=Казанский}{date=16.08.2011 12:50}{thema=}{post}Какие нафик дополнительные столбики?!  
Ctrl+H, заменить запятую на пусто. Заменить точку на запятую. Все.  
Можно в макрос записать, две строки будет.{/post}{/quote}  
Упс надо же как всё просто!!!!!!!спасибо!!
преобразовать данные в числовой формат
 
{quote}{login=KukLP}{date=16.08.2011 12:33}{thema=}{post}Запишите все свои действия макрорекордером и будет Вам счастье.{/post}{/quote}  
это то понятно,вот только количество сделок меняется,до какой ячейки умножать?если задашь больше ноли получатся,некрасиво
Страницы: 1 2 3 4 5 След.
Наверх