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

Вход

Регистрация

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

 

= Мир MS Excel/Теория вероятности Определить теоретич значения для удаления - Страница 4 - Мир MS Excel

Старая форма входа
  • Страница 4 из 5
  • «
  • 1
  • 2
  • 3
  • 4
  • 5
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Теория вероятности Определить теоретич значения для удаления (Макросы/Sub)
Теория вероятности Определить теоретич значения для удаления
lebensvoll Дата: Вторник, 05.04.2016, 12:15 | Сообщение № 61
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Прошу прощение (((((( ЗДРАВСТВУЙТЕ!!!
Не могу понять что случилось :-( все работало и тут раз и слетело [img][/img]
а также почему то не так сработал макрос в теме My WebPage
Цитата
Дата: Понедельник, 04.04.2016, 21:56 | Сообщение № 11
от _Boroda_ (((((
Что случилось то ведь все работало классно (((( :'( помогите исправить пожалуйста
К сообщению приложен файл: 4624346.xlsm (91.0 Kb)

Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеПрошу прощение (((((( ЗДРАВСТВУЙТЕ!!!
Не могу понять что случилось :-( все работало и тут раз и слетело [img][/img]
а также почему то не так сработал макрос в теме My WebPage
Цитата
Дата: Понедельник, 04.04.2016, 21:56 | Сообщение № 11
от _Boroda_ (((((
Что случилось то ведь все работало классно (((( :'( помогите исправить пожалуйста
Автор - lebensvoll
Дата добавления - 05.04.2016 в 12:15
lebensvoll Дата: Вторник, 05.04.2016, 12:29 | Сообщение № 62
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
По первому макросу я вроде исправил не знаю правильно ли. Спасибо огромное ТЕСКЕ он прописывал макрос с пояснениями
[vba]
Код
Sub tt()
    Dim e_ As Range 'e - массив ячеек
    Application.ScreenUpdating = 0 'отключаем обновление экрана
    r1_ = Range("E" & Rows.Count).End(xlUp).Row 'последняя заполненная строка в столбце D
    r0_ = 9 'первая строка
    n_ = 10 'кол-во столбцов
    For i = r0_ To r1_ 'цикл по строкам
        Set e_ = Range("E" & i).Resize(, n_) 'говорим, что e будет n ячеек вправо от столбца E i-ой строки
        x1_ = 0
        x2_ = 0
        For j = 1 To n_ ' цикл от одного до n (больше, чем n ячеек удалить просто не получится)
            'блок 1
            If x1_ = 0 Then 'если x1_=0, то
                mx_ = WorksheetFunction.Max(e_) 'ищем максимум по e
                mn_ = WorksheetFunction.Min(e_) 'ищем минимум по e
                On Error Resume Next 'пропускаем ошибку (на случай, если все значения пусты или =0)
                av_ = WorksheetFunction.Average(e_) 'ищем среднее по e
                e1_ = Err.Number ' присваиваем e значение ошибки (для деления на 0 ошибка 1004, иначе - false)
                On Error GoTo 0 'убираем пропуск ошибок
                z1_ = (mx_ - av_ <= 4) + e1_ = 0 'mx_ - av_ <= 4 даст true или false и плюс e
                    'даст 0 тогда, когда уже не нужно удалять лишнее
                If z1_ Then ' если z1 не 0, то
                    n1_ = WorksheetFunction.Match(mx_, e_, 0) 'ПОИСКПОЗом ищем позицию максимума в e
                    Range("E" & i).Offset(, n1_ - 1).ClearContents 'стираем ее
                Else 'если z1 = 0, то
                    x1_ = 1 'присваиваем х1 единицу
                    If x2_ Then 'если при этом и х2 тоже единица, то
                        Exit For 'выход из цикла
                    End If
                End If
            End If
            'блок 2 аналогично блоку 1
            If x2_ = 0 Then
                mn_ = WorksheetFunction.Min(e_)
                On Error Resume Next
                av_ = WorksheetFunction.Average(e_)
                e2_ = Err.Number
                On Error GoTo 0
                z2_ = (av_ - mn_ <= 4) + e2_ = 0
                If z2_ Then
                    n2_ = WorksheetFunction.Match(mn_, e_, 0)
                    Range("E" & i).Offset(, n2_ - 1).ClearContents
                Else
                    x2_ = 1
                    If x1_ Then
                        Exit For
                    End If
                End If
            End If
        Next j
    Next i
End Sub
[/vba]
Но и все равно у меня остаются не которые значения ((((( [img][/img]
НО вот почему вторые макросы то слетели ведь они работали же исправно (((((
[moder]
Цитата lebensvoll, 05.04.2016 в 12:29, в сообщении № 62
Спасибо огромное ТЕСКЕ
Меня уже давно мучаем вопрос: ТЕСКА - это кто или что? И почему именно так? Не, предположение у меня есть, но все-таки?

Кто бы ты ни был, мир в твоих руках

Сообщение отредактировал _Boroda_ - Вторник, 05.04.2016, 13:09
 
Ответить
СообщениеПо первому макросу я вроде исправил не знаю правильно ли. Спасибо огромное ТЕСКЕ он прописывал макрос с пояснениями
[vba]
Код
Sub tt()
    Dim e_ As Range 'e - массив ячеек
    Application.ScreenUpdating = 0 'отключаем обновление экрана
    r1_ = Range("E" & Rows.Count).End(xlUp).Row 'последняя заполненная строка в столбце D
    r0_ = 9 'первая строка
    n_ = 10 'кол-во столбцов
    For i = r0_ To r1_ 'цикл по строкам
        Set e_ = Range("E" & i).Resize(, n_) 'говорим, что e будет n ячеек вправо от столбца E i-ой строки
        x1_ = 0
        x2_ = 0
        For j = 1 To n_ ' цикл от одного до n (больше, чем n ячеек удалить просто не получится)
            'блок 1
            If x1_ = 0 Then 'если x1_=0, то
                mx_ = WorksheetFunction.Max(e_) 'ищем максимум по e
                mn_ = WorksheetFunction.Min(e_) 'ищем минимум по e
                On Error Resume Next 'пропускаем ошибку (на случай, если все значения пусты или =0)
                av_ = WorksheetFunction.Average(e_) 'ищем среднее по e
                e1_ = Err.Number ' присваиваем e значение ошибки (для деления на 0 ошибка 1004, иначе - false)
                On Error GoTo 0 'убираем пропуск ошибок
                z1_ = (mx_ - av_ <= 4) + e1_ = 0 'mx_ - av_ <= 4 даст true или false и плюс e
                    'даст 0 тогда, когда уже не нужно удалять лишнее
                If z1_ Then ' если z1 не 0, то
                    n1_ = WorksheetFunction.Match(mx_, e_, 0) 'ПОИСКПОЗом ищем позицию максимума в e
                    Range("E" & i).Offset(, n1_ - 1).ClearContents 'стираем ее
                Else 'если z1 = 0, то
                    x1_ = 1 'присваиваем х1 единицу
                    If x2_ Then 'если при этом и х2 тоже единица, то
                        Exit For 'выход из цикла
                    End If
                End If
            End If
            'блок 2 аналогично блоку 1
            If x2_ = 0 Then
                mn_ = WorksheetFunction.Min(e_)
                On Error Resume Next
                av_ = WorksheetFunction.Average(e_)
                e2_ = Err.Number
                On Error GoTo 0
                z2_ = (av_ - mn_ <= 4) + e2_ = 0
                If z2_ Then
                    n2_ = WorksheetFunction.Match(mn_, e_, 0)
                    Range("E" & i).Offset(, n2_ - 1).ClearContents
                Else
                    x2_ = 1
                    If x1_ Then
                        Exit For
                    End If
                End If
            End If
        Next j
    Next i
End Sub
[/vba]
Но и все равно у меня остаются не которые значения ((((( [img][/img]
НО вот почему вторые макросы то слетели ведь они работали же исправно (((((
[moder]
Цитата lebensvoll, 05.04.2016 в 12:29, в сообщении № 62
Спасибо огромное ТЕСКЕ
Меня уже давно мучаем вопрос: ТЕСКА - это кто или что? И почему именно так? Не, предположение у меня есть, но все-таки?
Автор - lebensvoll
Дата добавления - 05.04.2016 в 12:29
lebensvoll Дата: Вторник, 05.04.2016, 12:33 | Сообщение № 63
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Похоже я начал понимать в чем тут собака зарылась ((((( я в данный документ добавил столбцы . Т.е. они сместились теперь придется все во всем макросе изменять диапазоны и ячейки??? так???

Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеПохоже я начал понимать в чем тут собака зарылась ((((( я в данный документ добавил столбцы . Т.е. они сместились теперь придется все во всем макросе изменять диапазоны и ячейки??? так???
Автор - lebensvoll
Дата добавления - 05.04.2016 в 12:33
lebensvoll Дата: Вторник, 05.04.2016, 13:35 | Сообщение № 64
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
ТЕСКА это многоуважаемый _Boroda_, . Я сомневаюсь что теска (у каждого) может быть ЧТО :o Я правильно осознал проблему в работе макроса????
[moder]Александр, Вы меня пугаете! Определитесь как-то уже, а? То я вот такой
Цитата lebensvoll, 23.03.2016 в 11:14, в сообщении № 28
Тезка
, а то вот такой
Цитата lebensvoll, 28.03.2016 в 20:19, в сообщении № 4
Теска
Я за Вами не успеваю.

Кто бы ты ни был, мир в твоих руках

Сообщение отредактировал _Boroda_ - Вторник, 05.04.2016, 13:48
 
Ответить
СообщениеТЕСКА это многоуважаемый _Boroda_, . Я сомневаюсь что теска (у каждого) может быть ЧТО :o Я правильно осознал проблему в работе макроса????
[moder]Александр, Вы меня пугаете! Определитесь как-то уже, а? То я вот такой
Цитата lebensvoll, 23.03.2016 в 11:14, в сообщении № 28
Тезка
, а то вот такой
Цитата lebensvoll, 28.03.2016 в 20:19, в сообщении № 4
Теска
Я за Вами не успеваю.
Автор - lebensvoll
Дата добавления - 05.04.2016 в 13:35
Pelena Дата: Вторник, 05.04.2016, 13:40 | Сообщение № 65
Группа: Админы
Ранг: Местный житель
Сообщений: 19174
Репутация: 4413 ±
Замечаний: ±

Excel 365 & Mac Excel
[offtop] lebensvoll, ТЕСКА - это от слова ТЕСАТЬ, ОБТЁСЫВАТЬ.
А Александр всё же ТЁЗКА[/offtop]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение[offtop] lebensvoll, ТЕСКА - это от слова ТЕСАТЬ, ОБТЁСЫВАТЬ.
А Александр всё же ТЁЗКА[/offtop]
Автор - Pelena
Дата добавления - 05.04.2016 в 13:40
lebensvoll Дата: Вторник, 05.04.2016, 13:57 | Сообщение № 66
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Ни чего не пойму я все вроде изменил но результат ((((( не изменился в чем дело то ((((
[vba]
Код
Sub Макрос_1()
  Dim i&
  For i = 8 To 57
    If Cells(i, "V") <> "" And (Cells(i, "X") < -2 Or Cells(i, "X") > 2) Then
       Cells(i, "X").Value = Cells(i, "X").Value
       Cells(i, "X").Interior.ColorIndex = 36
       Cells(i, "Z") = "Отбраковывается"
       Cells(i, "Z").Interior.ColorIndex = 36
       Intersect(Rows(i), Range("V:v,AD:AE,AK:ak,AX:AZ")).ClearContents
    End If
    If Cells(i, "W") <> "" And (Cells(i, "Y") < -2 Or Cells(i, "Y") > 2) Then
       Cells(i, "Y").Value = Cells(i, "Y").Value
       Cells(i, "Y").Interior.ColorIndex = 36
       Cells(i, "Z") = "Отбраковывается"
       Cells(i, "Z").Interior.ColorIndex = 36
       Intersect(Rows(i), Range("W:W,AN:AO,AU:au,AX:AZ")).ClearContents
    End If
  Next
    If Range("AU60") <= 1.5 And Range("AW61") >= 0.7 And (Range("AJ63") >= 6 And Range("AJ63") <= 15) Then
     MsgBox "Условие выполнено, процедура закончена"
     Exit Sub
  Else
     If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then
       Макрос_2
     End If
  End If
End Sub
Sub Макрос_2()
  Dim x&, j&, M@, B@
  M = -1.9
  B = 1.9
  For x = 1 To 20
    For j = 8 To 57
      If Cells(j, "W") <> "" And (Cells(j, "Y") < M Or Cells(j, "Y") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then
         Cells(j, "Y").Value = Cells(j, "Y").Value
         Cells(j, "Y").Interior.ColorIndex = 36
         Cells(j, "Z") = "Отбраковывается"
         Cells(j, "Z").Interior.ColorIndex = 36
         Intersect(Rows(j), Range("W:W,AN:AO,AU:au,AX:AZ")).ClearContents
      End If
    Next j
      If Range("AU60") <= 1.5 And Range("AW61") >= 0.7 And (Range("AJ63") >= 6 And Range("AJ63") <= 15) Then
       MsgBox "Условие выполнено, процедура закончена"
       Exit Sub
    Else
       If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then
          M = M + 0.1
          B = B - 0.1
          Cells(3, "X") = M
          Cells(3, "Y") = B
       Else
          Cells(3, "X") = ""
          Cells(3, "Y") = ""
          Exit Sub
       End If
    End If
  Next x
End Sub

'1. Если в ячейке X14 значение (">2;>-2")
'УДАЛЯЛИСЬ значения из ячеек: X14; AD:AE14; AK14; AX:AZ14.

'2. Если в ячейке Y14 значение (">2;>-2")
'УДАЛИЛИСЬ значения из ячеек: Y14; AN:AO14; AU14

'макрос №2
'должен определить в столбце Y приблеженные значения к (>2; <-2)
'окрасить их, а в столбце Z прописать "отбраковывается"
'и удалить значения из ячеек: Y; AN:AO; AU; AX:AZ.
'Но, при этом значения в столбце "Y" не изменилось после удаления

[/vba]

Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеНи чего не пойму я все вроде изменил но результат ((((( не изменился в чем дело то ((((
[vba]
Код
Sub Макрос_1()
  Dim i&
  For i = 8 To 57
    If Cells(i, "V") <> "" And (Cells(i, "X") < -2 Or Cells(i, "X") > 2) Then
       Cells(i, "X").Value = Cells(i, "X").Value
       Cells(i, "X").Interior.ColorIndex = 36
       Cells(i, "Z") = "Отбраковывается"
       Cells(i, "Z").Interior.ColorIndex = 36
       Intersect(Rows(i), Range("V:v,AD:AE,AK:ak,AX:AZ")).ClearContents
    End If
    If Cells(i, "W") <> "" And (Cells(i, "Y") < -2 Or Cells(i, "Y") > 2) Then
       Cells(i, "Y").Value = Cells(i, "Y").Value
       Cells(i, "Y").Interior.ColorIndex = 36
       Cells(i, "Z") = "Отбраковывается"
       Cells(i, "Z").Interior.ColorIndex = 36
       Intersect(Rows(i), Range("W:W,AN:AO,AU:au,AX:AZ")).ClearContents
    End If
  Next
    If Range("AU60") <= 1.5 And Range("AW61") >= 0.7 And (Range("AJ63") >= 6 And Range("AJ63") <= 15) Then
     MsgBox "Условие выполнено, процедура закончена"
     Exit Sub
  Else
     If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then
       Макрос_2
     End If
  End If
End Sub
Sub Макрос_2()
  Dim x&, j&, M@, B@
  M = -1.9
  B = 1.9
  For x = 1 To 20
    For j = 8 To 57
      If Cells(j, "W") <> "" And (Cells(j, "Y") < M Or Cells(j, "Y") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then
         Cells(j, "Y").Value = Cells(j, "Y").Value
         Cells(j, "Y").Interior.ColorIndex = 36
         Cells(j, "Z") = "Отбраковывается"
         Cells(j, "Z").Interior.ColorIndex = 36
         Intersect(Rows(j), Range("W:W,AN:AO,AU:au,AX:AZ")).ClearContents
      End If
    Next j
      If Range("AU60") <= 1.5 And Range("AW61") >= 0.7 And (Range("AJ63") >= 6 And Range("AJ63") <= 15) Then
       MsgBox "Условие выполнено, процедура закончена"
       Exit Sub
    Else
       If MsgBox("Условие не выполнено. Продолжить?", vbYesNo) = 6 Then
          M = M + 0.1
          B = B - 0.1
          Cells(3, "X") = M
          Cells(3, "Y") = B
       Else
          Cells(3, "X") = ""
          Cells(3, "Y") = ""
          Exit Sub
       End If
    End If
  Next x
End Sub

'1. Если в ячейке X14 значение (">2;>-2")
'УДАЛЯЛИСЬ значения из ячеек: X14; AD:AE14; AK14; AX:AZ14.

'2. Если в ячейке Y14 значение (">2;>-2")
'УДАЛИЛИСЬ значения из ячеек: Y14; AN:AO14; AU14

'макрос №2
'должен определить в столбце Y приблеженные значения к (>2; <-2)
'окрасить их, а в столбце Z прописать "отбраковывается"
'и удалить значения из ячеек: Y; AN:AO; AU; AX:AZ.
'Но, при этом значения в столбце "Y" не изменилось после удаления

[/vba]
Автор - lebensvoll
Дата добавления - 05.04.2016 в 13:57
lebensvoll Дата: Вторник, 05.04.2016, 14:00 | Сообщение № 67
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Прошу у всех прощение за мой русский язык ((((( а также у много уважаемого ТЕЗКИ!!! Спасибо за пояснения к орфографии, в школе учился плохо да еще и в ТУРКМЕНСКОЙ так что :'(

Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеПрошу у всех прощение за мой русский язык ((((( а также у много уважаемого ТЕЗКИ!!! Спасибо за пояснения к орфографии, в школе учился плохо да еще и в ТУРКМЕНСКОЙ так что :'(
Автор - lebensvoll
Дата добавления - 05.04.2016 в 14:00
lebensvoll Дата: Вторник, 05.04.2016, 14:06 | Сообщение № 68
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Да почему это всплывает не понятная Х
Цитата
If Cells(j, "W") <> "" And (Cells(j, "Y") < M Or Cells(j, "Y") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then
в макросе не так все пишется ((((( че за засада

Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеДа почему это всплывает не понятная Х
Цитата
If Cells(j, "W") <> "" And (Cells(j, "Y") < M Or Cells(j, "Y") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then
в макросе не так все пишется ((((( че за засада
Автор - lebensvoll
Дата добавления - 05.04.2016 в 14:06
lebensvoll Дата: Вторник, 05.04.2016, 15:50 | Сообщение № 69
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
УВАЖАЕМЫЕ ГЕНИИ, прошу вас откликнуться. Подскажите в чем проблема???? Что не так я сотварил в данном документе (((( что перестало работать (((((

Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеУВАЖАЕМЫЕ ГЕНИИ, прошу вас откликнуться. Подскажите в чем проблема???? Что не так я сотварил в данном документе (((( что перестало работать (((((
Автор - lebensvoll
Дата добавления - 05.04.2016 в 15:50
Roman777 Дата: Вторник, 05.04.2016, 16:04 | Сообщение № 70
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
lebensvoll, можете в файлике показать?

Много чего не знаю!!!!
 
Ответить
Сообщениеlebensvoll, можете в файлике показать?
Автор - Roman777
Дата добавления - 05.04.2016 в 16:04
al-Ex Дата: Вторник, 05.04.2016, 16:10 | Сообщение № 71
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 59 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
If Cells(j, "W") <> "" And (Cells(j, "Y") < M Or Cells(j, "Y") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then
[/vba]
Если вы вообще читаете то на эту строчку Вам указывали ещё 1.04.16 в постах выше
Если перевести на русский эта строка примерно так "Звучит":
If - если
Cells(j, "W") <> "" - ячейка в строке j столбца "W" неравна "пусто"
And - и
(Cells(j, "Y") < M - ячейка в строке j столбца "Y" меньше М
Or - или
Cells(j, "Y") > - ячейка в строке j столбца "Y" ,больше
<img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> вот эта фигня фактически означает смайлик в посте типа :cool: specool вы её видимо скопипастили откуда-то вместе с кодом.
конечно её не должно здесь быть. Что тут должно стоять по смыслу макроса, наверно только Василич знает.


Сообщение отредактировал al-Ex - Вторник, 05.04.2016, 16:13
 
Ответить
Сообщение[vba]
Код
If Cells(j, "W") <> "" And (Cells(j, "Y") < M Or Cells(j, "Y") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then
[/vba]
Если вы вообще читаете то на эту строчку Вам указывали ещё 1.04.16 в постах выше
Если перевести на русский эта строка примерно так "Звучит":
If - если
Cells(j, "W") <> "" - ячейка в строке j столбца "W" неравна "пусто"
And - и
(Cells(j, "Y") < M - ячейка в строке j столбца "Y" меньше М
Or - или
Cells(j, "Y") > - ячейка в строке j столбца "Y" ,больше
<img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> вот эта фигня фактически означает смайлик в посте типа :cool: specool вы её видимо скопипастили откуда-то вместе с кодом.
конечно её не должно здесь быть. Что тут должно стоять по смыслу макроса, наверно только Василич знает.
Автор - al-Ex
Дата добавления - 05.04.2016 в 16:10
lebensvoll Дата: Вторник, 05.04.2016, 16:11 | Сообщение № 72
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Roman777,
Цитата
Дата: Вторник, 05.04.2016, 12:15 | Сообщение № 61
я сейчас не на работе (((( а он там ((( так его можно с этого сообщения посмотреть

Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеRoman777,
Цитата
Дата: Вторник, 05.04.2016, 12:15 | Сообщение № 61
я сейчас не на работе (((( а он там ((( так его можно с этого сообщения посмотреть
Автор - lebensvoll
Дата добавления - 05.04.2016 в 16:11
lebensvoll Дата: Вторник, 05.04.2016, 16:13 | Сообщение № 73
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
al-Ex,
Цитата
скопипастили
вот имено что я этого не делал ((((. В самом макросе ее нет и пишется все нормально. Но когда я переношу ее на форум (((( она мне почему то именно в этом месте так прописывает (((
[moder]Попробуйте вставить не к тегах кода макроса, а в тегах цитаты. Если не получится, то вообще без тегов, а мы посмотрим, что там на самом деле.

Кто бы ты ни был, мир в твоих руках

Сообщение отредактировал _Boroda_ - Вторник, 05.04.2016, 16:19
 
Ответить
Сообщениеal-Ex,
Цитата
скопипастили
вот имено что я этого не делал ((((. В самом макросе ее нет и пишется все нормально. Но когда я переношу ее на форум (((( она мне почему то именно в этом месте так прописывает (((
[moder]Попробуйте вставить не к тегах кода макроса, а в тегах цитаты. Если не получится, то вообще без тегов, а мы посмотрим, что там на самом деле.
Автор - lebensvoll
Дата добавления - 05.04.2016 в 16:13
lebensvoll Дата: Вторник, 05.04.2016, 16:23 | Сообщение № 74
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Цитата

If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > B) Then
это так вы имели в вдиу
[moder]Нет! ОДНУ строку

Кто бы ты ни был, мир в твоих руках

Сообщение отредактировал lebensvoll - Вторник, 05.04.2016, 16:32
 
Ответить
Сообщение
Цитата

If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > B) Then
это так вы имели в вдиу
[moder]Нет! ОДНУ строку
Автор - lebensvoll
Дата добавления - 05.04.2016 в 16:23
lebensvoll Дата: Вторник, 05.04.2016, 16:25 | Сообщение № 75
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Вот наверное где собака то зарыта (((((
Цитата
If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > B) Then
что это за смайлик (((( поэтому он ее и коверкает копипастит так сказать

Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеВот наверное где собака то зарыта (((((
Цитата
If Cells(j, "U") <> "" And (Cells(j, "W") < M Or Cells(j, "W") > B) Then
что это за смайлик (((( поэтому он ее и коверкает копипастит так сказать
Автор - lebensvoll
Дата добавления - 05.04.2016 в 16:25
Roman777 Дата: Вторник, 05.04.2016, 16:25 | Сообщение № 76
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
lebensvoll, Вы с телефона или планшета?
по Вашему файлу из сообщения 61 видно, что д. б. >B а не >кулл

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Вторник, 05.04.2016, 16:27
 
Ответить
Сообщениеlebensvoll, Вы с телефона или планшета?
по Вашему файлу из сообщения 61 видно, что д. б. >B а не >кулл
Автор - Roman777
Дата добавления - 05.04.2016 в 16:25
al-Ex Дата: Вторник, 05.04.2016, 16:32 | Сообщение № 77
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 59 ±
Замечаний: 0% ±

Excel 2010
Цитата lebensvoll, 05.04.2016 в 16:25, в сообщении № 75
Вот наверное где собака то зарыта
Да уж! На пятый день "открылась истина". я-же предлагал "cool" на "lol" lol заменить ещё второго числа.
Цитата al-Ex, 02.04.2016 в 00:23, в сообщении № 58
Тут "lol.gif" больше подходит, чем "сооl", думаю.
Значение в ячейке листа, нельзя со смайликом в посте форума, сравнивать, - " Mismatch Типо"


Сообщение отредактировал al-Ex - Вторник, 05.04.2016, 16:43
 
Ответить
Сообщение
Цитата lebensvoll, 05.04.2016 в 16:25, в сообщении № 75
Вот наверное где собака то зарыта
Да уж! На пятый день "открылась истина". я-же предлагал "cool" на "lol" lol заменить ещё второго числа.
Цитата al-Ex, 02.04.2016 в 00:23, в сообщении № 58
Тут "lol.gif" больше подходит, чем "сооl", думаю.
Значение в ячейке листа, нельзя со смайликом в посте форума, сравнивать, - " Mismatch Типо"
Автор - al-Ex
Дата добавления - 05.04.2016 в 16:32
lebensvoll Дата: Вторник, 05.04.2016, 16:38 | Сообщение № 78
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Roman777, а что это
Цитата
что д. б. >B а не >кулл
???
al-Ex, и в чем же она??? Да и главное что она НАЙДЕНА так ведь.
Я вообще так думаю в связи с тем что я дополнил файл макросом от ТЕЗКИ [vba]
Код
Sub tt()
    Dim d_ As Range 'd - массив ячеек
    Application.ScreenUpdating = 0 'отключаем обновление экрана
    r1_ = Range("D" & Rows.Count).End(xlUp).Row 'последняя заполненная строка в столбце D
    r0_ = 4 'первая строка
    n_ = 10 'кол-во столбцов
    For i = r0_ To r1_ 'цикл по строкам
        Set d_ = Range("D" & i).Resize(, n_) 'говорим, что d будет n ячеек вправо от столбца D i-ой строки
        x1_ = 0
        x2_ = 0
        For j = 1 To n_ ' цикл от одного до n (больше, чем n ячеек удалить просто не получится)
            'блок 1
            If x1_ = 0 Then 'если x1_=0, то
                mx_ = WorksheetFunction.Max(d_) 'ищем максимум по d
                mn_ = WorksheetFunction.Min(d_) 'ищем минимум по d
                On Error Resume Next 'пропускаем ошибку (на случай, если все значения пусты или =0)
                av_ = WorksheetFunction.Average(d_) 'ищем среднее по d
                e1_ = Err.Number ' присваиваем e значение ошибки (для деления на 0 ошибка 1004, иначе - false)
                On Error GoTo 0 'убираем пропуск ошибок
                z1_ = (mx_ - av_ <= 4) + e1_ = 0 'mx_ - av_ <= 4 даст true или false и плюс e
                    'даст 0 тогда, когда уже не нужно удалять лишнее
                If z1_ Then ' если z1 не 0, то
                    n1_ = WorksheetFunction.Match(mx_, d_, 0) 'ПОИСКПОЗом ищем позицию максимума в d
                    Range("D" & i).Offset(, n1_ - 1).ClearContents 'стираем ее
                Else 'если z1 = 0, то
                    x1_ = 1 'присваиваем х1 единицу
                    If x2_ Then 'если при этом и х2 тоже единица, то
                        Exit For 'выход из цикла
                    End If
                End If
            End If
            'блок 2 аналогично блоку 1
            If x2_ = 0 Then
                mn_ = WorksheetFunction.Min(d_)
                On Error Resume Next
                av_ = WorksheetFunction.Average(d_)
                e2_ = Err.Number
                On Error GoTo 0
                z2_ = (av_ - mn_ <= 4) + e2_ = 0
                If z2_ Then
                    n2_ = WorksheetFunction.Match(mn_, d_, 0)
                    Range("D" & i).Offset(, n2_ - 1).ClearContents
                Else
                    x2_ = 1
                    If x1_ Then
                        Exit For
                    End If
                End If
            End If
        Next j
    Next i
End Sub
[/vba] при этом понимаю что тут нужно изменить ячейки, ведь ТАК???
Далее мне пришлось внести два столбца (((( в связи с этим макрос №1 и №2 (с капипастом) также изменились ячейки. Мне нужно лишь изменить наименование ячеек и диапазонов. ПРАВИЛЬНО???

Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеRoman777, а что это
Цитата
что д. б. >B а не >кулл
???
al-Ex, и в чем же она??? Да и главное что она НАЙДЕНА так ведь.
Я вообще так думаю в связи с тем что я дополнил файл макросом от ТЕЗКИ [vba]
Код
Sub tt()
    Dim d_ As Range 'd - массив ячеек
    Application.ScreenUpdating = 0 'отключаем обновление экрана
    r1_ = Range("D" & Rows.Count).End(xlUp).Row 'последняя заполненная строка в столбце D
    r0_ = 4 'первая строка
    n_ = 10 'кол-во столбцов
    For i = r0_ To r1_ 'цикл по строкам
        Set d_ = Range("D" & i).Resize(, n_) 'говорим, что d будет n ячеек вправо от столбца D i-ой строки
        x1_ = 0
        x2_ = 0
        For j = 1 To n_ ' цикл от одного до n (больше, чем n ячеек удалить просто не получится)
            'блок 1
            If x1_ = 0 Then 'если x1_=0, то
                mx_ = WorksheetFunction.Max(d_) 'ищем максимум по d
                mn_ = WorksheetFunction.Min(d_) 'ищем минимум по d
                On Error Resume Next 'пропускаем ошибку (на случай, если все значения пусты или =0)
                av_ = WorksheetFunction.Average(d_) 'ищем среднее по d
                e1_ = Err.Number ' присваиваем e значение ошибки (для деления на 0 ошибка 1004, иначе - false)
                On Error GoTo 0 'убираем пропуск ошибок
                z1_ = (mx_ - av_ <= 4) + e1_ = 0 'mx_ - av_ <= 4 даст true или false и плюс e
                    'даст 0 тогда, когда уже не нужно удалять лишнее
                If z1_ Then ' если z1 не 0, то
                    n1_ = WorksheetFunction.Match(mx_, d_, 0) 'ПОИСКПОЗом ищем позицию максимума в d
                    Range("D" & i).Offset(, n1_ - 1).ClearContents 'стираем ее
                Else 'если z1 = 0, то
                    x1_ = 1 'присваиваем х1 единицу
                    If x2_ Then 'если при этом и х2 тоже единица, то
                        Exit For 'выход из цикла
                    End If
                End If
            End If
            'блок 2 аналогично блоку 1
            If x2_ = 0 Then
                mn_ = WorksheetFunction.Min(d_)
                On Error Resume Next
                av_ = WorksheetFunction.Average(d_)
                e2_ = Err.Number
                On Error GoTo 0
                z2_ = (av_ - mn_ <= 4) + e2_ = 0
                If z2_ Then
                    n2_ = WorksheetFunction.Match(mn_, d_, 0)
                    Range("D" & i).Offset(, n2_ - 1).ClearContents
                Else
                    x2_ = 1
                    If x1_ Then
                        Exit For
                    End If
                End If
            End If
        Next j
    Next i
End Sub
[/vba] при этом понимаю что тут нужно изменить ячейки, ведь ТАК???
Далее мне пришлось внести два столбца (((( в связи с этим макрос №1 и №2 (с капипастом) также изменились ячейки. Мне нужно лишь изменить наименование ячеек и диапазонов. ПРАВИЛЬНО???
Автор - lebensvoll
Дата добавления - 05.04.2016 в 16:38
Roman777 Дата: Вторник, 05.04.2016, 16:42 | Сообщение № 79
Группа: Проверенные
Ранг: Ветеран
Сообщений: 980
Репутация: 127 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
lebensvoll, Вместо:
[vba]
Код
If Cells(j, "W") <> "" And (Cells(j, "Y") < M Or Cells(j, "Y") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then
[/vba]
[vba]
Код
If Cells(j, "W") <> "" And (Cells(j, "Y") < M Or Cells(j, "Y") > B
[/vba]
Ну это у Вас в файле в сообщении №61 так... я честно говоря не смотрел, что такое переменная B.

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Вторник, 05.04.2016, 16:43
 
Ответить
Сообщениеlebensvoll, Вместо:
[vba]
Код
If Cells(j, "W") <> "" And (Cells(j, "Y") < M Or Cells(j, "Y") > <img rel="usm" src="http://www.excelworld.ru/sml2/cool.gif" border="0" align="absmiddle" alt="B)" /> Then
[/vba]
[vba]
Код
If Cells(j, "W") <> "" And (Cells(j, "Y") < M Or Cells(j, "Y") > B
[/vba]
Ну это у Вас в файле в сообщении №61 так... я честно говоря не смотрел, что такое переменная B.
Автор - Roman777
Дата добавления - 05.04.2016 в 16:42
lebensvoll Дата: Вторник, 05.04.2016, 16:56 | Сообщение № 80
Группа: Проверенные
Ранг: Старожил
Сообщений: 1002
Репутация: 30 ±
Замечаний: 0% ±

Excel 2010
Почему до этого все работало отлично и лишь когда я дополнил два столбца и добавил новый макрос (((( бац и все слетает.
Да он в макросе так и пишется сами смотрите [img][/img] что изменять то((( раз я вам говорю что когда я его на форум перекидываю он почему то приписывает не понятно что именно тут
Цитата
src="http://www.excelworld.ru/sml2/cool.gif" border="0"
. Просто много уважаемые ГЕНИИ прикалываются я так понимаю ((((
Цитата
я-же предлагал "cool" на "lol" lol заменить ещё второго числа.
Хотел бы я посмотреть на них в работе с бетонной смесью или же неразрушающего контроля. Все мы ГЕНИИ в своей сфере...
СПАСИБО

Кто бы ты ни был, мир в твоих руках
 
Ответить
СообщениеПочему до этого все работало отлично и лишь когда я дополнил два столбца и добавил новый макрос (((( бац и все слетает.
Да он в макросе так и пишется сами смотрите [img][/img] что изменять то((( раз я вам говорю что когда я его на форум перекидываю он почему то приписывает не понятно что именно тут
Цитата
src="http://www.excelworld.ru/sml2/cool.gif" border="0"
. Просто много уважаемые ГЕНИИ прикалываются я так понимаю ((((
Цитата
я-же предлагал "cool" на "lol" lol заменить ещё второго числа.
Хотел бы я посмотреть на них в работе с бетонной смесью или же неразрушающего контроля. Все мы ГЕНИИ в своей сфере...
СПАСИБО
Автор - lebensvoll
Дата добавления - 05.04.2016 в 16:56
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Теория вероятности Определить теоретич значения для удаления (Макросы/Sub)
  • Страница 4 из 5
  • «
  • 1
  • 2
  • 3
  • 4
  • 5
  • »
Поиск:

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