Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 3 След.
Считать с Input диапазон и вставить значения на лист
 
Извините я болван)))
Спасибо большое
qweewert
Считать с Input диапазон и вставить значения на лист
 
Добавил в модульь, сделал кнопку. но почему-то не работает, я не очень силен в VBA, наверно что-то не так сделал.
Код
Sub фівфівфів()'
i = 2

Do While ThisWorkbook.Sheets("Input").Cells(i, 1) <> ""
         ThisWorkbook.Sheets(CStr(ThisWorkbook.Sheets("Input").Cells(i, 1))).Range(CStr(ThisWorkbook.Sheets("Input").Cells(i, 2))) = ThisWorkbook.Sheets("Input").Cells(i, 3)
          i = i + 1
Loop
End Sub
Изменено: qweewert - 12 Апр 2018 19:24:00
qweewert
Считать с Input диапазон и вставить значения на лист
 

Сделал)) извините

Изменено: qweewert - 12 Апр 2018 11:46:52
qweewert
Считать с Input диапазон и вставить значения на лист
 
Доброго времени суток!

Пишу через VBA лог изменений в txt файл формата Названия листа | $AO$461 | значение. Потом я эти текстовые данные копирую в другой файл ексель, мне нужно прочитать эти данные с помощью VBA и перенести в соответствующие ячейки на новом листе,-указание выше
+ Как можно применить те же  действие но только по выделеной области в листе  Input?

Большое спасибо!
Изменено: qweewert - 12 Апр 2018 13:43:42
qweewert
Указать примечания из ячеек в ListBox'e на пользовательской форме., Как перенести значения из примечаний ячеек в listbox
 
большое спасибо!!!!
Изменено: qweewert - 1 Янв 2018 05:05:44
qweewert
ListBox поиск на по мере набирания текста, - Источник CONCATENATE ячейка, Можно как-то сделать как в динамическом фильтре ячейке L10 файла .
 
пробую открыть файл по ссылке, выдаёт  ошибку
не понимаю почему, запостил фото ошибки туда
Изменено: qweewert - 1 Янв 2018 01:49:59
qweewert
Указать примечания из ячеек в ListBox'e на пользовательской форме., Как перенести значения из примечаний ячеек в listbox
 
win7x86 office 2007

что нужно включить в tools/references?
Изменено: qweewert - 1 Янв 2018 01:47:09
qweewert
ListBox поиск на по мере набирания текста, - Источник CONCATENATE ячейка, Можно как-то сделать как в динамическом фильтре ячейке L10 файла .
 
Спасибо за идею Дмитрию Тарковскому тиц[/P]

Поиск через фильтр ячейка L10 ищет как угодно, что продемонстрировал на видео (видео по 25 сек).  Фишка в том, что ищет как угодно и со второго слова и даже с куска слова со средины….  https://photos.app.goo.gl/y963eU91zMKO2l913

А как такой поиск реализовать через форму. На данном примере настроил по нажатию на 1 столбец ячейке (красн.яч.). У меня получилось сделать только поиск по одному столбцу и только если набирать с первой буквы ((((
Можно как-то сделать как в динамическом фильтре на примере ячейки L10?
Изменено: qweewert - 1 Янв 2018 19:03:53
qweewert
Заполнение одного ListBox на основании информации из другого ListBox по мере набирания текста
 

пришло извините в спам попало

спасибо

qweewert
Заполнение одного ListBox на основании информации из другого ListBox по мере набирания текста
 

а можете  выложить свой пример как это сделали?

спасибо

qweewert
Макрос для записи ЛОГ изменений ячеек в txt файл по всей книге не работает в ThisWorkbook, Если вставить, как есть то ничего не происходит.
 

Я таким способом мониторю изменения в файл и если что-то случилось я смогу посмотреть последние значения или использовать как резервную копию.

Плюс в том что запись происходит незаметно.

1. если файл не сохранится я могу посмотреть все что вводил до этого. У меня бил случай когда ни файл ни копия которая создается через vba не сохранилось и тога я нашел этот макрос и проблема пропала, если что я могу посмотреть кто что и когда менял.

2. Работает но только если макрос в листе

3. это я обхожу вытягиваем значений с ячеек через форму

Код
Private Sub EditList_Click()
'Dim lLastRow As Long
'   lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
'   If IsNumeric(Cells(lLastRow, 1)) Then _
'Cells(lLastRow + 1, 1).Value = Cells(lLastRow, 1).Value + 1 Else _
'Oae eonie oi aeua aiaaaey? a inoaii?e ?yaie oaaeeo? oaeno
Cells(myRow, 2).Resize(, 10) = Array(CDate(Me.MyDate), exp.Value, inc.Value, _
  gru.Value, pgr.Value, cat.Value, pca.Value, , , Opys.Value)
Close #1
    filepath = ThisWorkbook.Path & "\"
    'Filename = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & "_log.txt"
    Filename = "LOG_EXCEL.txt"
    Open filepath & Filename For Append As #1
 On Error Resume Next
    Print #1, Application.UserName; " " & Date & " " & Time & " "; ThisWorkbook.Name & " "; ActiveSheet.Name & "   " & ActiveCell.Address; ";", _
    ; Me.MyDate & ";" _
    ; exp.Value & ";" & inc.Value & ";", _
    gru.Value & ";" & pgr.Value & ";" & cat.Value & ";" & pca.Value & " ;" & " ;" & " ;" & Opys.Value
    On Error Resume Next
    Close #1
    original = Target.Text
'Cells(myRow, 6) = pgr.Value
'Opys.ValueClear
'Clear ia?aiao? ?enoeou aai? iiey ye? aea?ao aea ?iainu iai?ao??
EditMyForm.Hide
End Sub

Изменено: qweewert - 30 Дек 2017 16:13:26
qweewert
Макрос для записи ЛОГ изменений ячеек в txt файл по всей книге не работает в ThisWorkbook, Если вставить, как есть то ничего не происходит.
 
Не работает так
Код
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
в модуле "Эта Книга"
Массово не подходит, тут фишка что текстовой файл сохраняется сразу мгновенно без задержки.
qweewert
Макрос для записи ЛОГ изменений ячеек в txt файл по всей книге не работает в ThisWorkbook, Если вставить, как есть то ничего не происходит.
 

Доброго времени суток.

Макрос создает файл LOG.txt в корне где пишет изменения.

Для того чтоб работал нужно прописывать в каждый лист, а можно ли сделать чтоб работал для всех листов. Если вставить, как есть то ничего не происходит.

Очень благодарен

Код
Private Sub Worksheet_Change(ByVal Target As Range)

    ActiveSheet.Calculate
  Close #1
    filepath = ThisWorkbook.Path & "\"
    'Filename = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & "_log.txt"
    Filename = "LOG_EXCEL.txt"
    Open filepath & Filename For Append As #1

  
    On Error Resume Next
    Print #1, Application.UserName; " " & Date & " " & Time & " "; ThisWorkbook.Name & " "; ActiveSheet.Name & "   " & " cell " & Target.Address & " : ;ñòàðå = ;[" & original & "], íîâå = ;[" & Target.Value & "]"
    On Error Resume Next
    Close #1
    original = Target.Text
End Sub

Изменено: qweewert - 27 Дек 2017 14:53:46
qweewert
UserForm проблема с выборкой даты из ячейки до 9 числа .
 

RAN – Шерлок ))- работает, большое спасибо!!!!

qweewert
UserForm проблема с выборкой даты из ячейки до 9 числа .
 
Прошу помощи

Видео проблемы
https://www.dropbox.com/s/zp7vvnaqxbkjdko/screencast%202017-12-23%2015-50-08.mp4squeeze.mp4?dl=0
UserForm. Проблема с выборкой даты из ячейки до 9 числа , каждый раз когда загружает значение из ячейки: меняет местами дни и месяц.
Не знаю, как обойти.

Очень благодарю заранее.
qweewert
Как в UserForm вводить значение все сразу
 
Вы гений большое спасибо извините что не понял с первого раза:)
Вопрос решен!! Благодарю Казанский очень выручили!!
qweewert
Как в UserForm вводить значение все сразу
 
Кнопка цитирования не для ответа [МОДЕРАТОР]

Цитата
Юрий М написал: зачем Вы на форме добавили непонятные контролы...?
Я не очень силен в VBA. Наверно по незнанию добавил…. Массивом это вводить в одну ячейку, а потом разбивать на все столбцы? А нельзя сделать это кодом VBA?

Отключить калькуляцию не могу, поскольку она у меня отключена по умолчанию и когда я делаю изменения VBA срабатывают на листе, а как отключить отключенное не знаю…..)))

на листе калькуляция у меня

Код
Private Sub Worksheet_Change(ByVal Target As Range)

Dim shtLog As Worksheet
Dim cll As Variant
Dim lngNextRow As Long

Close #1
    Filepath = ThisWorkbook.Path & "\"
    'Filename = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & "_log.txt"
    Filename = "LOG_EXCEL.txt"
    Open Filepath & Filename For Append As #1

    On Error Resume Next
    Print #1, Date & " " & Time & " " & ThisWorkbook.Name & " " & " cell " & Target.Address & " : ñòàðå = [" & original & "], íîâå = [" & Target.Value & "]"
    On Error Resume Next
    Close #1
    original = Target.Text
'Code by Sumit Bansal from http://trumpexcel.com
'On Error GoTo Handler
'If Target.Column = 3 And Target.Value <> "" Then
'Application.EnableEvents = False
''Target.Offset(0, -1) = Format(Now(), "dd.mm.yyyy")
'Target.Offset(0, -1) = Date
'Application.EnableEvents = True
'End If
'Handler:



ActiveSheet.Calculate




    Dim FilterCol As Integer
    Dim FilterRange As Range
    Dim CondtitionString As Variant
    Dim Condition1 As String, Condition2 As String
 
    If Intersect(Target, Range("ÔÑ")) Is Nothing Then Exit Sub
 
    On Error Resume Next
    Application.ScreenUpdating = False
     
    'îïðåäåëÿåì äèàïàçîí äàííûõ ñïèñêà
   Set FilterRange = Range("Table7")
     
    'ñ÷èòûâàåì óñëîâèÿ èç âñåõ èçìåíåííûõ ÿ÷ååê äèàïàçîíà óñëîâèé
    For Each cell In Target.Cells
        FilterCol = cell.Column - FilterRange.Columns(1).Column + 1
         
        If IsEmpty(cell) Then
            Target.Parent.Range(FilterRange.Address).AutoFilter field:=FilterCol
            ' çàëèøຠïóñò³ òà ô³ëüòðè
            Sheets("Çâ³ò").Range("A11:S11").EntireRow.Hidden = False
            On Error Resume Next
Sheets("Çâ³ò").Range("B6:B15000").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False

        Else
            If InStr(1, UCase(cell.Value), " ÀÁÎ ") > 0 Then
                LogicOperator = xlOr
                ConditionArray = Split(UCase(cell.Value), " ÀÁÎ ")
            Else
                If InStr(1, UCase(cell.Value), " ² ") > 0 Then
                    LogicOperator = xlAnd
                    ConditionArray = Split(UCase(cell.Value), " ² ")
                Else
                    ConditionArray = Array(cell.Text)
                End If
            End If
            'ôîðìèðóåì ïåðâîå óñëîâèå
            If Left(ConditionArray(0), 1) = "<" Or Left(ConditionArray(0), 1) = ">" Then
                Condition1 = ConditionArray(0)
            Else
                Condition1 = "=*" & ConditionArray(0) & "*"
            End If
            'ôîðìèðóåì âòîðîå óñëîâèå - åñëè îíî åñòü
            If UBound(ConditionArray) = 1 Then
                If Left(ConditionArray(1), 1) = "<" Or Left(ConditionArray(1), 1) = ">" Then
                    Condition2 = ConditionArray(1)
                Else
                    Condition2 = "=*" & ConditionArray(1) & "*"
                End If
            End If
            'âêëþ÷àåì ôèëüòðàöèþ
            If UBound(ConditionArray) = 0 Then
                Target.Parent.Range(FilterRange.Address).AutoFilter field:=FilterCol, Criteria1:=Condition1
                ' çàëèøຠïóñò³ òà ô³ëüòðè
            Sheets("Çâ³ò").Range("A11:S11").EntireRow.Hidden = False
            On Error Resume Next
Sheets("Çâ³ò").Range("B6:B15000").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False
            Else
                Target.Parent.Range(FilterRange.Address).AutoFilter field:=FilterCol, Criteria1:=Condition1, _
                    Operator:=LogicOperator, Criteria2:=Condition2
                    ' çàëèøຠïóñò³ òà ô³ëüòðè
            Sheets("Çâ³ò").Range("A11:S11").EntireRow.Hidden = False
            On Error Resume Next
    Sheets("Çâ³ò").Range("B6:B15000").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = False
            End If
        End If
    Next cell
     
    Set FilterRange = Nothing
    Application.ScreenUpdating = True   
End Sub
Изменено: qweewert - 20 Дек 2017 01:20:46
qweewert
Как в UserForm вводить значение все сразу
 
Код
Cells(myRow, 2).Resize(, 3) = Array(CDate(Me.MyDate), exp.Value, inc.Value, gru.Value, pgr.Value, cat.Value, pca.Value, Opys.Value)

не работает, вводит только дату в столбец 2
qweewert
Как в UserForm вводить значение все сразу
 
Здравствуйте

Имеется форма ввода каждый параметр вводиться поочередно по умолчанию, а у меня таблица очень большая и это занимает секунд 5 (каждый пункт вводиться в ячейку и идет небольшой перечет.
manual calculate не могу применить
На листе ввода вшиты макросы которые делают изменение только ячеек на 3 столбце вверх и вниз от курсора потому менять параметр manual calculate не могу нужно чтоб вводило все сразу если это возможно конечно….

Как сделать так чтоб вводилось за один заход?
пример. как есть
1. вводит CDate
2. вводит exp
3. вводит inc
Код
Cells(myRow, 2) = CDate(Me.MyDate)
Cells(myRow, 3) = exp.Value
Cells(myRow, 4) = inc.Value

Как нужно:
1. вводит CDate,exp,inc
Код
Cells(myRow, 2) = CDate(Me.MyDate), Cells(myRow, 3) = exp.Value, Cells(myRow, 4) = inc.Value

Заранее очень благодарен!
Изменено: qweewert - 19 Дек 2017 19:41:00
qweewert
VBA автосохранение каждые н минут + автовыход если ничего не происходит через н минут, В примере файл постоянно открывается заново, прописал stop Ontime, но все равно открывается после закрытия
 
Добавил проверку при закрытии и макросы выполняются но все равно книга опять открывается

Код
Sub StopTimerq()
    On Error Resume Next
    Application.OnTime RunWhenq, Procedure:=cRunWhatq, _
        Schedule:=False
Err.Clear: On Error GoTo 0: On Error GoTo -1
    MsgBox "Done"

Sub StopTimer()
    On Error Resume Next
    Application.OnTime RunWhen, Procedure:=cRunWhat, _
        Schedule:=False
Err.Clear: On Error GoTo 0: On Error GoTo -1
    MsgBox "Done"
End Sub

в Workbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimerq
StopTimer

End Sub
Изменено: qweewert - 23 Июн 2017 22:23:04
qweewert
VBA автосохранение каждые н минут + автовыход если ничего не происходит через н минут, В примере файл постоянно открывается заново, прописал stop Ontime, но все равно открывается после закрытия
 
в   ThisWorkbook
Код
Option Explicit
Private Sub Workbook_Open()
     Application.Calculation = xlManual
    StartTimer
    StartTimerq
End Sub
'Private Sub Worksheet_Change(ByVal Target As Range)
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.Calculation = xlManual
ActiveSheet.Calculate
StartTimerq
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
StartTimerq
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
  StartTimerq
End Sub
Private Sub Workbook_Activate()
  StartTimerq
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimerq
StopTimer
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    ThisWorkbook.Names.Add "prevsh__", Sh.Name
End Sub
Изменено: qweewert - 23 Июн 2017 16:44:36
qweewert
VBA автосохранение каждые н минут + автовыход если ничего не происходит через н минут, В примере файл постоянно открывается заново, прописал stop Ontime, но все равно открывается после закрытия
 
Так у меня в модуле
Код
Option Explicit
Public RunWhen As Double
Public Const cRunIntervalSeconds = 8 ' sec
Public Const cRunWhat = "TheSub"  ' the name of the procedure to run
Public RunWhenq As Double
Public Const cRunIntervalSecondsq = 20 ' sec
Public Const cRunWhatq = "TheSubq"  ' the name of the procedure to run
Sub StartTimer()
    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=True
End Sub
Sub TheSub()

If ThisWorkbook.Saved = False Then
    ThisWorkbook.Save
    StartTimer
    
    Else
    StartTimer
    End If

End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=False
End Sub
Sub StartTimerq()
    RunWhenq = Now + TimeSerial(0, 0, cRunIntervalSecondsq)
    Application.OnTime EarliestTime:=RunWhenq, Procedure:=cRunWhatq, _
        Schedule:=True
End Sub
Sub TheSubq()
With ActiveWorkbook
    .Save
    .Close
End With
End Sub
Sub StopTimerq()
    On Error Resume Next
    Application.OnTime EarliestTime:=RunWhenq, Procedure:=cRunWhatq, _
        Schedule:=False
End Sub
Изменено: qweewert - 23 Июн 2017 16:42:24
qweewert
VBA автосохранение каждые н минут + автовыход если ничего не происходит через н минут, В примере файл постоянно открывается заново, прописал stop Ontime, но все равно открывается после закрытия
 
Спасибо, но не знаю что с этим делать. Можно попросить на примере сделать?
qweewert
VBA автосохранение каждые н минут + автовыход если ничего не происходит через н минут, В примере файл постоянно открывается заново, прописал stop Ontime, но все равно открывается после закрытия
 
Добрий день уважаемие гуру екселя!!!!!!
Прошу помощи

Как только прописываю  ActiveWorkbook или ThisWorkbook  .Close файл начинает заново открываться.
Вроде в BeforeClose все прописал

Что нужно добиться:
Если открывать несколько файлов где прописан данный макрос, когда вносишь изменения, файл автоматически сохранєтса каждые 5 мин, если файл изменился.
Єсли нет изменений в файле, то он закрывается через н минут, сохранив при этом изменения, если они есть.
Хочу сократить количество автосохранения переменной “Если файл изменился”
Планирую использовать эти макросы одновременно в нескольких открытых файлах. Ели будут конфликтовать Ontime как можно обойти?
Буду очень благодарен за помощь не владею языком программирования уже всю голову сломал методом тыка)))


Очень важно чтоб работала функция If ThisWorkbook.Saved = False Then, чтоб сохранялся только если есть изменения.

Рабочий пример прикрепляю
Вот где брал идею

http://www.cpearson.com/excel/OnTime.aspx

Изменено: qweewert - 23 Июн 2017 16:46:46
qweewert
Макрос для нескольких (определенных) листов книги
 
И да и нет. Вручную ето очень долго в моем случає. И я всегда делал изменения макросами вручную, и переменял на каждый отдельный, а теперь ето намного проще. Только что пробовал на рабочем листе сделал 3 клика копи-паст, нажал,- и оно все делает само.

Этот макрос экономит просто кучу времени, искал его где то год. И наконец Planetaexcel, и гуру екселя помогли. Спасиб.
qweewert
Макрос для нескольких (определенных) листов книги
 
Цитата
iba2004 пишет:Но я всё равно не понял. Этот вариант будет работатиь, по-моему, только для листов "Точка1", "Точка2", "Точка3"
Да но ничего не мешает добавить иные название листов  по аналогии ("Точка1", "Точка2", "Точка3", "чтоугодно1", "чтоугодно2") и так далее.
qweewert
Макрос для нескольких (определенных) листов книги
 
Господин Кузьмич большое спасибо, теперь все работает. Все что теперь нужно так ето записать макрос вставить в Ваш макрос и запустить. Пробовал добавлять другие листи. Все работает.

Спасибо за терпение, и понимание Kuzmich,iba2004,ikki.

Господин Кузьмич низкий поклон!!!!
qweewert
Макрос для нескольких (определенных) листов книги
 
Цитата
Kuzmich пишет: Я вам писал вариант, вы его попробовали?
Да но там еррор
Єсли можно впишите в файл
qweewert
Макрос для нескольких (определенных) листов книги
 
Цитата
iba2004 пишет:
т.е. нужно выполнить на всех листах до листа"Итог"? как Вы этот список будете объявлять программе?
Если ето возможно выполнить макрос на листах с названиями Ціна,Зима,весна,Лето,осень
Все остальные листи я неуказую потому и макрос не будет на них распостранятса. Но я незнаю как ето зделать
qweewert
Макрос для нескольких (определенных) листов книги
 
Цитата
iba2004 пишет: Как она поймёт, что на "Зима" не нужно???
Хорошо

Есть листи
ЦІНА
Зима
Весна
Лето
Осень
Итог
Таблицы
Заказ
Нужно применить макрос к:
Ціни
Зима
Весна
Лето
Осень
На прикреплённому файле нужно применять к:
Лист1
Лист2
Лист3
qweewert
Страницы: 1 2 3 След.
Наверх