Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос удаляющий значения в ячейке - Страница 3 - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 3 из 3«123
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос удаляющий значения в ячейке (Макросы/Sub)
Макрос удаляющий значения в ячейке
Mark1976 Дата: Воскресенье, 17.04.2016, 17:41 | Сообщение № 41
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
StoTisteg, я разобрался с формулой. Спасибо. буду ее использовать в работе. Вот только еще разобраться как применить ее к 60 ти файлам.
 
Ответить
СообщениеStoTisteg, я разобрался с формулой. Спасибо. буду ее использовать в работе. Вот только еще разобраться как применить ее к 60 ти файлам.

Автор - Mark1976
Дата добавления - 17.04.2016 в 17:41
StoTisteg Дата: Воскресенье, 17.04.2016, 18:28 | Сообщение № 42
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Просто это, как два пальца об асфальт.[vba]
Код
Sub Формулы()

    Dim cl As Integer, i As Integer, rw As Integer, clzc As Integer, clmon As Integer
    
    MsgBox "Откройте нужные файлы"
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
        For i = 1 To .SelectedItems.Count
            If InStr(1, .SelectedItems(i), ".xls", vbTextCompare) <> 0 Then
                Workbooks.Open Filename:=SelectedItems(i)
                On Error Resume Next
                cl = Cells.Find(What:="тклонение", LookAt:=xlPart).Column
                On Error Resume Next
                clzc = Cells.Find(What:="ЗЦ текущая", LookAt:=xlPart).Column - cl
                On Error Resume Next
                clmon = Cells.Find(What:="РЦ текущая", LookAt:=xlPart).Column - cl
                On Error Resume Next
                rw = Cells.Find(What:="тклонение", LookAt:=xlPart).Row + 1
                If Err.Number = 0 Then Range(Cells(rw, cl), Cells(Cells(Rows.Count, 1).End(xlUp).Row, cl)).FormulaR1C1 = "=IF(OR(ROUND(RC[" & clmon & "]/RC[" & clzc & "]-1,2)=0,ROUND(RC[" & clmon & "]/RC[" & clzc & "]-1,2)=-1),"""",RC[" & clmon & "]/RC[" & clzc & "]-1)"
                ActiveWorkbook.Save
                ActiveWorkbook.Close
            End If
        Next i
        
End Sub
[/vba]
Научились бы Вы сами чему-нибудь, Марк, а? А то два дня, блин, из Вас выдавливали, что Вам нужно, как раба из Чехова, а делов на 15 минут.
К сообщению приложен файл: Monitoring.xlsm(15Kb)


Проверь всё. ThisWorkbook.Save. On Error Resume Next.

Сообщение отредактировал StoTisteg - Воскресенье, 17.04.2016, 20:50
 
Ответить
СообщениеПросто это, как два пальца об асфальт.[vba]
Код
Sub Формулы()

    Dim cl As Integer, i As Integer, rw As Integer, clzc As Integer, clmon As Integer
    
    MsgBox "Откройте нужные файлы"
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
        For i = 1 To .SelectedItems.Count
            If InStr(1, .SelectedItems(i), ".xls", vbTextCompare) <> 0 Then
                Workbooks.Open Filename:=SelectedItems(i)
                On Error Resume Next
                cl = Cells.Find(What:="тклонение", LookAt:=xlPart).Column
                On Error Resume Next
                clzc = Cells.Find(What:="ЗЦ текущая", LookAt:=xlPart).Column - cl
                On Error Resume Next
                clmon = Cells.Find(What:="РЦ текущая", LookAt:=xlPart).Column - cl
                On Error Resume Next
                rw = Cells.Find(What:="тклонение", LookAt:=xlPart).Row + 1
                If Err.Number = 0 Then Range(Cells(rw, cl), Cells(Cells(Rows.Count, 1).End(xlUp).Row, cl)).FormulaR1C1 = "=IF(OR(ROUND(RC[" & clmon & "]/RC[" & clzc & "]-1,2)=0,ROUND(RC[" & clmon & "]/RC[" & clzc & "]-1,2)=-1),"""",RC[" & clmon & "]/RC[" & clzc & "]-1)"
                ActiveWorkbook.Save
                ActiveWorkbook.Close
            End If
        Next i
        
End Sub
[/vba]
Научились бы Вы сами чему-нибудь, Марк, а? А то два дня, блин, из Вас выдавливали, что Вам нужно, как раба из Чехова, а делов на 15 минут.

Автор - StoTisteg
Дата добавления - 17.04.2016 в 18:28
StoTisteg Дата: Воскресенье, 17.04.2016, 18:37 | Сообщение № 43
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Причём вангую, что через неделю Вы придёте к закономерному выводу, что открывать и закрывать 60 файлов неудобно и неплохо бы иметь их все в одной книге. Потом дойдёте до мысли, что сводки по препаратам удобнее, чем по аптекам... Ей-Богу, Вы доведёте форум до того, что при виде Вашего ника все будут разбегаться в панике и ужасе :D


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеПричём вангую, что через неделю Вы придёте к закономерному выводу, что открывать и закрывать 60 файлов неудобно и неплохо бы иметь их все в одной книге. Потом дойдёте до мысли, что сводки по препаратам удобнее, чем по аптекам... Ей-Богу, Вы доведёте форум до того, что при виде Вашего ника все будут разбегаться в панике и ужасе :D

Автор - StoTisteg
Дата добавления - 17.04.2016 в 18:37
Mark1976 Дата: Воскресенье, 17.04.2016, 18:41 | Сообщение № 44
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
StoTisteg, спасибо за помощь. Учиться программировать уже не тот возраст, да и начальных знаний в этом нет. Спасибо что помогаете таким как я. Иногда сразу изложить мысль бывает сложно, а потом доходит, что надо было так написать.


Сообщение отредактировал Mark1976 - Воскресенье, 17.04.2016, 18:42
 
Ответить
СообщениеStoTisteg, спасибо за помощь. Учиться программировать уже не тот возраст, да и начальных знаний в этом нет. Спасибо что помогаете таким как я. Иногда сразу изложить мысль бывает сложно, а потом доходит, что надо было так написать.

Автор - Mark1976
Дата добавления - 17.04.2016 в 18:41
Mark1976 Дата: Воскресенье, 17.04.2016, 18:44 | Сообщение № 45
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
StoTisteg, ошибка в строке [vba]
Код
With Application.FileDialog
[/vba]
 
Ответить
СообщениеStoTisteg, ошибка в строке [vba]
Код
With Application.FileDialog
[/vba]

Автор - Mark1976
Дата добавления - 17.04.2016 в 18:44
RAN Дата: Воскресенье, 17.04.2016, 19:25 | Сообщение № 46
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4277
Репутация: 829 ±
Замечаний: 0% ±

2010
Первый палец выделяет FileDialog, второй жмет F1, третий водит по справке, и обнаруживает отсутствие параметров диалога (какой нужен)


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеПервый палец выделяет FileDialog, второй жмет F1, третий водит по справке, и обнаруживает отсутствие параметров диалога (какой нужен)

Автор - RAN
Дата добавления - 17.04.2016 в 19:25
StoTisteg Дата: Воскресенье, 17.04.2016, 20:46 | Сообщение № 47
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Mark1976, если у Вас в нике ГР, так я Вас на 7 лет старше и о VBA первый раз услышал год назад :)


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеMark1976, если у Вас в нике ГР, так я Вас на 7 лет старше и о VBA первый раз услышал год назад :)

Автор - StoTisteg
Дата добавления - 17.04.2016 в 20:46
StoTisteg Дата: Воскресенье, 17.04.2016, 20:51 | Сообщение № 48
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
отсутствие параметров диалога

Точно. Вредно полагаться на память :)


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение
отсутствие параметров диалога

Точно. Вредно полагаться на память :)

Автор - StoTisteg
Дата добавления - 17.04.2016 в 20:51
RAN Дата: Воскресенье, 17.04.2016, 21:53 | Сообщение № 49
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4277
Репутация: 829 ±
Замечаний: 0% ±

2010
StoTisteg, такие кардинальные изменения не грех комментировать.
Через неделю ни я, ни вы не вспомните, зачем писанина была, ежели код правильный! :o


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеStoTisteg, такие кардинальные изменения не грех комментировать.
Через неделю ни я, ни вы не вспомните, зачем писанина была, ежели код правильный! :o

Автор - RAN
Дата добавления - 17.04.2016 в 21:53
StoTisteg Дата: Воскресенье, 17.04.2016, 22:00 | Сообщение № 50
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
В смысле — кардинальные? Я ж просто пропущенный параметр добавил.


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеВ смысле — кардинальные? Я ж просто пропущенный параметр добавил.

Автор - StoTisteg
Дата добавления - 17.04.2016 в 22:00
Mark1976 Дата: Воскресенье, 17.04.2016, 22:02 | Сообщение № 51
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
Не хочет работать макрос. Сам пробовал исправить,через справку, не получилось.
 
Ответить
СообщениеНе хочет работать макрос. Сам пробовал исправить,через справку, не получилось.

Автор - Mark1976
Дата добавления - 17.04.2016 в 22:02
StoTisteg Дата: Воскресенье, 17.04.2016, 22:04 | Сообщение № 52
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
А что говорит-то? У меня просто нет Ваших файлов, я не могу его проверить...


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеА что говорит-то? У меня просто нет Ваших файлов, я не могу его проверить...

Автор - StoTisteg
Дата добавления - 17.04.2016 в 22:04
Mark1976 Дата: Воскресенье, 17.04.2016, 22:09 | Сообщение № 53
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
Вот скрин. При нажатии на кнопку добавить
К сообщению приложен файл: 1255493.jpg(45Kb)
 
Ответить
СообщениеВот скрин. При нажатии на кнопку добавить

Автор - Mark1976
Дата добавления - 17.04.2016 в 22:09
StoTisteg Дата: Воскресенье, 17.04.2016, 22:10 | Сообщение № 54
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Дошло. Я вместо окончательного варианта промежуточный нерабочий выложил :(
[vba]
Код
Sub Формулы()

    Dim cl As Integer, i As Integer, rw As Integer, clzc As Integer, clmon As Integer
    
    MsgBox "Откройте нужные файлы"
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
        For i = 1 To .SelectedItems.Count
            If InStr(1, .SelectedItems(i), ".xls", vbTextCompare) <> 0 Then
                Workbooks.Open Filename:=.SelectedItems(i)
                On Error Resume Next
                cl = Cells.Find(What:="тклонение", LookAt:=xlPart).Column
                On Error Resume Next
                clzc = Cells.Find(What:="ЗЦ текущая", LookAt:=xlPart).Column - cl
                On Error Resume Next
                clmon = Cells.Find(What:="ониторинг", LookAt:=xlPart).Column - cl
                On Error Resume Next
                rw = Cells.Find(What:="тклонение", LookAt:=xlPart).Row + 1
                If Err.Number = 0 Then Range(Cells(rw, cl), Cells(Cells(Rows.Count, 1).End(xlUp).Row, cl)).FormulaR1C1 = "=IF(OR(ROUND(RC[" & clmon & "]/RC[" & clzc & "]-1,2)=0,ROUND(RC[" & clmon & "]/RC[" & clzc & "]-1,2)=-1),"""",RC[" & clmon & "]/RC[" & clzc & "]-1)"
                ActiveWorkbook.Save
                ActiveWorkbook.Close
            End If
        Next i
    End With
        
End Sub
[/vba]
К сообщению приложен файл: 0511494.xlsm(17Kb)


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеДошло. Я вместо окончательного варианта промежуточный нерабочий выложил :(
[vba]
Код
Sub Формулы()

    Dim cl As Integer, i As Integer, rw As Integer, clzc As Integer, clmon As Integer
    
    MsgBox "Откройте нужные файлы"
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
        For i = 1 To .SelectedItems.Count
            If InStr(1, .SelectedItems(i), ".xls", vbTextCompare) <> 0 Then
                Workbooks.Open Filename:=.SelectedItems(i)
                On Error Resume Next
                cl = Cells.Find(What:="тклонение", LookAt:=xlPart).Column
                On Error Resume Next
                clzc = Cells.Find(What:="ЗЦ текущая", LookAt:=xlPart).Column - cl
                On Error Resume Next
                clmon = Cells.Find(What:="ониторинг", LookAt:=xlPart).Column - cl
                On Error Resume Next
                rw = Cells.Find(What:="тклонение", LookAt:=xlPart).Row + 1
                If Err.Number = 0 Then Range(Cells(rw, cl), Cells(Cells(Rows.Count, 1).End(xlUp).Row, cl)).FormulaR1C1 = "=IF(OR(ROUND(RC[" & clmon & "]/RC[" & clzc & "]-1,2)=0,ROUND(RC[" & clmon & "]/RC[" & clzc & "]-1,2)=-1),"""",RC[" & clmon & "]/RC[" & clzc & "]-1)"
                ActiveWorkbook.Save
                ActiveWorkbook.Close
            End If
        Next i
    End With
        
End Sub
[/vba]

Автор - StoTisteg
Дата добавления - 17.04.2016 в 22:10
Mark1976 Дата: Воскресенье, 17.04.2016, 22:25 | Сообщение № 55
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
StoTisteg, Спасибо. Если захочу сменить колонку, меняю название здесь?
[vba]
Код
clzc = Cells.Find(What:="ЗЦ текущая", LookAt:=xlPart).Column - cl
[/vba]
Больше ничего не трогаю?
 
Ответить
СообщениеStoTisteg, Спасибо. Если захочу сменить колонку, меняю название здесь?
[vba]
Код
clzc = Cells.Find(What:="ЗЦ текущая", LookAt:=xlPart).Column - cl
[/vba]
Больше ничего не трогаю?

Автор - Mark1976
Дата добавления - 17.04.2016 в 22:25
StoTisteg Дата: Воскресенье, 17.04.2016, 22:27 | Сообщение № 56
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Да, колонки ищутся по фрагментам заголовка.
[vba]
Код
cl = Cells.Find(What:="тклонение", LookAt:=xlPart).Column 'поиск колонки, в которую пишем формулу по фрагменту заголовка "тклонение"
clzc = Cells.Find(What:="ЗЦ текущая", LookAt:=xlPart).Column - cl 'поиск делителя по фрагменту "ЗЦ текущая". Точнее, вычисление расстояния между формулой и делителем
clmon = Cells.Find(What:="ониторинг", LookAt:=xlPart).Column - cl 'расстояние между делимым (фрагмент заголовка "ониторинг") и формулой
rw = Cells.Find(What:="тклонение", LookAt:=xlPart).Row 'поиск последней строки таблицы
[/vba]


Проверь всё. ThisWorkbook.Save. On Error Resume Next.

Сообщение отредактировал StoTisteg - Воскресенье, 17.04.2016, 22:38
 
Ответить
СообщениеДа, колонки ищутся по фрагментам заголовка.
[vba]
Код
cl = Cells.Find(What:="тклонение", LookAt:=xlPart).Column 'поиск колонки, в которую пишем формулу по фрагменту заголовка "тклонение"
clzc = Cells.Find(What:="ЗЦ текущая", LookAt:=xlPart).Column - cl 'поиск делителя по фрагменту "ЗЦ текущая". Точнее, вычисление расстояния между формулой и делителем
clmon = Cells.Find(What:="ониторинг", LookAt:=xlPart).Column - cl 'расстояние между делимым (фрагмент заголовка "ониторинг") и формулой
rw = Cells.Find(What:="тклонение", LookAt:=xlPart).Row 'поиск последней строки таблицы
[/vba]

Автор - StoTisteg
Дата добавления - 17.04.2016 в 22:27
Mark1976 Дата: Воскресенье, 17.04.2016, 22:30 | Сообщение № 57
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
а эта формула где меняется?
Код
=ЕСЛИ(ИЛИ(ОКРУГЛ(O4/H4-1;2)=0;ОКРУГЛ(O4/H4-1;2)=-1);"";O4/H4-1)
 
Ответить
Сообщениеа эта формула где меняется?
Код
=ЕСЛИ(ИЛИ(ОКРУГЛ(O4/H4-1;2)=0;ОКРУГЛ(O4/H4-1;2)=-1);"";O4/H4-1)

Автор - Mark1976
Дата добавления - 17.04.2016 в 22:30
StoTisteg Дата: Воскресенье, 17.04.2016, 22:41 | Сообщение № 58
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Нигде. Если так и надо что-то на что-то делить и вычитать единицу, то и не трогайте её. А вообще она в строке
[vba]
Код
If Err.Number = 0 Then Range(Cells(rw, cl), Cells(Cells(Rows.Count, 1).End(xlUp).Row, cl)).FormulaR1C1 = "=IF(OR(ROUND(RC[" & clmon & "]/RC[" & clzc & "]-1,2)=0,ROUND(RC[" & clmon & "]/RC[" & clzc & "]-1,2)=-1),"""",RC[" & clmon & "]/RC[" & clzc & "]-1)"
[/vba]
сидит, как видите. If Err.Number = 0 Then проверяет, что найдены все нужные колонки.


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеНигде. Если так и надо что-то на что-то делить и вычитать единицу, то и не трогайте её. А вообще она в строке
[vba]
Код
If Err.Number = 0 Then Range(Cells(rw, cl), Cells(Cells(Rows.Count, 1).End(xlUp).Row, cl)).FormulaR1C1 = "=IF(OR(ROUND(RC[" & clmon & "]/RC[" & clzc & "]-1,2)=0,ROUND(RC[" & clmon & "]/RC[" & clzc & "]-1,2)=-1),"""",RC[" & clmon & "]/RC[" & clzc & "]-1)"
[/vba]
сидит, как видите. If Err.Number = 0 Then проверяет, что найдены все нужные колонки.

Автор - StoTisteg
Дата добавления - 17.04.2016 в 22:41
Mark1976 Дата: Воскресенье, 17.04.2016, 22:49 | Сообщение № 59
Группа: Проверенные
Ранг: Обитатель
Сообщений: 331
Репутация: 0 ±
Замечаний: 40% ±

Excel 2007
StoTisteg, ок
 
Ответить
СообщениеStoTisteg, ок

Автор - Mark1976
Дата добавления - 17.04.2016 в 22:49
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос удаляющий значения в ячейке (Макросы/Sub)
Страница 3 из 3«123
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!