Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » kudim
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Перевод 5-ти бальной оценки в распределение по шкале
 
#
06.11.2019 11:56:28
Всем привет!

Прошу прощение за тупой вопрос, но хочу удостовериться в следующем.

У меня есть две анкеты за разные годы, в одной из них оценки указаны в баллах по 5-ти бальной шкале, то есть вот так:
Основные барьеры в развитии  Вашего бизнесаСредний бал
Экономический спад3,59
Недостаток   инвестиций2,90
Недоразвитость   инфраструктуры2,62
Недостаток   оборотных средств2,95
Кризис   неплатежей3,64
Низкий уровень внутреннего потребления3,29
Другое   (укажите)1,67
и вторая анкета, в которой дано распределение по баллам, из 1800 баллов:
Основные   барьеры в развитии  Вашего бизнесаБаллы
Экономический   спад533
Низкий уровень внутреннего потребления518
Кризис   неплатежей413
Недостаток   инвестиций104
Другое (Высокая конкуренция)100
Недоразвитость   инфраструктуры74
Недостаток   оборотных средств58
Итого баллов1 800
Я же правильно понимаю, что невозможно перевести одни баллы в другие?
Изменено: kudim - 06.11.2019 11:56:51
 
Перейти    
Удаление повторяющихся значений из одной ячейки
 
#
04.06.2019 16:45:11
Добрый день! Есть столбец, в котором, например, 5 тысяч ячеек. В каждой ячейке записаны числа через запятую, среди этих чисел есть повторения. Я пытаюсь написать макрос, который бы удалял эти повторения. Например: есть ячейка (5.65; 6.01; 5.3; 10; 12; 10.1; 10; 5; 6.01) после выполнения макроса хочу, чтобы ячейка преобразовывалась в (5.65; 6.01; 5.3; 12; 10.1; 10; 5). Пример во вложении. Надеюсь на вашу помощь.
 
Перейти    
Exit For - неправильно прерывается вложенный цикл For
 
#
27.02.2019 12:53:16
Здравствуйте!

Есть следующий цикл
Код
For i = 1 To regLastRow
For j = 1 To dataLastRow

    If InStr(1, ArrData(j, 1), ArrReg(i, 1), vbTextCompare) > 0 And ArrData(j, 2) = "" Then
             ArrData(j, 2) = ArrReg(i, 2)
                 Exit for
     End If
      
Next j
Next i

То есть в массиве ArrReg расположен справочник, а в массиве ArrData - база
Требуется, чтобы при первом вхождении строки из справочника в любую строку базы, цикл прерывался, и проверялась следующая строка справочника.
При этом, найденной строке базы присваивается значение из справочника.

Сейчас цикл прерывается неправильно,  в справочнике находятся не все значения. Как прервать цикл правильно?
 
Перейти    
В файле .XLSB при открытии не отображается список макросов
 
#
01.02.2019 16:10:48
Здравствуйте!

Возникла следующая проблема: есть несколько файлов с разрешением .XLSB. В каждом из них расположена группа макросов под определенную задачу.
Сегодня один из этих файлов перестал работать. При открытии самого файла, и выводе списка макросов (Alt+F8), макросы не отображаются.

В неисправном файле при нажатии Alt+F11 (открытие редактора VBA)  =>  F2 (открытие Object browser) и выборе в выпадающем списке "VBA Project"  - эксель зависает и слетает.
Остальные несколько файлов с разрешением .XLSB запускаются нормально.

В чем может быть проблема?

UPD: также не работает кнопка "Запись макроса" в этом файле (выдает ошибку "введено недопустимое имя...." - на любое имя файла) , в других файлах запись работает
Изменено: kudim - 01.02.2019 21:57:00
 
Перейти    
Пр ссылке на ячейку ошибка Object doesn't support this property or method
 
#
26.04.2018 10:06:53
Добрый день!

Никак не могу справиться с ошибкой 438: Object doesn't support this property or method

Она по непонятной причине возникает на строке
Код
Worksheets("массив").Сells(1, 2).Value = "dfdf"
Сам макрос может выглядеть вот так
Код
Sub Ошибка438()
Worksheets("массив").Сells(1, 2).Value = "dfdf"
End sub
Страница "массив" в книге есть.

В чем может быть причина.
 
Перейти    
VBA: вхождение определенного шаблона в текстовую строку
 
#
05.04.2018 16:01:44
Добрый день!

Мне необходимо найти, есть ли вхождение определенного шаблона в строку. Для этого я через оператор Like задаю шаблон и далее ищу его вхождение строки.
Тогда код выглядит следующим образом
Код
  For i = 1 To iLastRow
  
    StrGT = "*диаметр ##*"
If Worksheets("обработка").Cells(i, 2).Value Like StrGT Then
Worksheets("обработка").Cells(i, 3).Value = "+"
End if
Next i
Однако, мне нужно не только найти факт вхождения шаблона, но и обрабатывать найденный шаблон. Например, если одна из строк имеет следующий вид:
Цитата
квадрат со стороной 2, треугольник равнобедренный, круг диаметр 32, шестигранник"
Я хочу выхватить число 32 и записать его в соседний столбец.

Как это возможно реализовать?
 
Перейти    
Ошибка при применении функции Left в VBA
 
#
23.01.2018 12:03:11
Добрый день! Никак не могу понять, в чем ошибка .

использую следующий код
Код
iLastRow = Workbooks(WB).Worksheets("массив").Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To iLastRow
Workbooks(WB).Worksheets("массив").Сells(i, 4).Value = Left((Workbooks(WB).Worksheets("массив").Сells(i, 22).Value), 2) + "." + _
Right(Workbooks(WB).Worksheets("массив").Сells(i, 22), 2) + "." + Workbooks(WB).Worksheets("массив").Сells(i, 2).Value

Next i
при его выполнении, на строке 3 вылетает ошибка Object does not support this method. Проблема именно в функции Left, так как она сохарается, даже если убрать все, кроме этой строки
Код
Workbooks(WB).Worksheets("массив").Сells(3, 4).Value = Left((Workbooks(WB).Worksheets("массив").Сells(3, 22).Value), 2)
Изменено: kudim - 23.01.2018 12:23:08
 
Перейти    
Различные комбинации из трех столбцов текста, ошибка Type Mismatch
 
#
21.12.2017 09:31:11

Всем привет. Мне необходимо создать различные комбинации из трех столбцов текста. Один столбец включает в себя числа, другой текстовые значения, третий - пробел и пустую ячейку. Однако при работе макроса возникает ошибка. Файл прикладываю. На странице диаметры - исходные данные, на странице комбинации - должны быть комбинации трех столбцов.

Код
Sub Создание_комбинаций()
iLastRow = Worksheets("диаметры").Cells(Rows.Count, 2).End(xlUp).Row
jLastRow = Worksheets("диаметры").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("комбинации").Cells(1, 14).Value = " "
Worksheets("комбинации").Cells(2, 14).Value = ""
t = 1
For i = 2 To iLastRow
For j = 2 To jLastRow
For k = 1 To 2
Worksheets("комбинации").Cells(t, 1).Value = Worksheets("диаметры").Cells(i, 2).Value + Worksheets("комбинации").Cells(k, 14).Value + Worksheets("диаметры").Cells(j, 1).Value
t = t + 1
Next k
Next j
Next i
End Sub

Изменено: kudim - 21.12.2017 12:13:10
 
Перейти    
Нахождение определенного числа в строке при помощи VBA
 
#
20.12.2017 11:43:35
Добрый день! У меня есть описание определенного товара, в котором встречаются многие его характеристики. Они перечислены по разному, как в примере.
НОВЫЕ, ИЗГОТОВЛЕНЫ ПО ТС 1545324,  ДЛЯ  КОНСТРУКЦИЙ, Ф 358.0Х 13.0 ММ - 3 ШТ    
ИСПОЛЬЗОВАННЫЕ, ИЗГОТОВЛЕНЫ ПО 23425 ДЛЯ К, Размер 135.0Х 13.0 ММ - 3 ШТ            
ИЗДЕЛИЯ ИЗ МЕТАЛЛОВ; ПО ГОСТ 535435; ДИАМЕТРОМ 234Х7ММ; НЕ МАРТЕНСИТОСТАРЕЮЩИЕ,НЕ ЯВЛЯЮТСЯ ДВОЙНЫМИ
Я хочу написать макрос, который выделял бы диаметр изделий из описания. На данный момент у меня есть идея реализовать это через поиск в каждой строке описания следующей комбинации

"Ф_число"   где "_" это пробел
"Фчисло", "диаметр_число", "диаметрчисло", "диаметромчисло", "диаметром_число", "размер_число"  

и так далее

То есть хочу, чтобы макрос находил вышеописанную комбинацию, и записывал в определенную ячейку само "число", то есть диаметр.

Хочу услышать ваши советы какие функции нужно использовать, чтобы это реализовать.
Изменено: kudim - 20.12.2017 11:44:10
 
Перейти    
Разделение данных по столбцам с помощью VBA
 
#
15.12.2017 15:25:43

Добрый день! Мне необходимо разделить данные в каждом столбце. Ячейка имеет вид "данные1; данные2; данные3; данные4; данные5".

На данный момент имею следующий код

Код
Sub разделение()
iLastRow = Worksheets("описание").Cells(Rows.Count, 1).End(xlUp).Row  
For j = 1 To iLastRow
p = Split(Cells(i, 2), "; ")
For i = 0 To UBound(p)
Cells(j, i + 3) = p(i)
Next i
p = 0
Next j
End Sub

Но этот код выдает ошибку "Application definet or object defined error". Возможно, я неправильно задаю переменную. Помогите пожалуйста разобраться в чем ошибка.

Изменено: kudim - 15.12.2017 15:42:50
 
Перейти    
Суммирование только положительных значений в сводной таблице
 
#
11.09.2017 16:13:34
Всем привет! Подскажите пожалуйста, есть ли возможность в экселе сделать так, чтобы в сводной таблице суммировались только положительные значения.
 
Перейти    
Как задать номер столбца для заполнения при цикле "For Each Cell in Range"
 
#
25.07.2017 11:01:03
Добрый день!
Мне нужно произвести поиск определенных значений только в отсортированных ячейках. Для этого я вначале произвожу сортировку при помощи расширенного фильтра ( в коде не показано ), а затем использую цикл "For each Cell.....". При помощи этого цикла я произвожу поиск вхождений искомого текста в исследуемый диапазон.
После того, как вхождение найдено, мне необходимо записать найденное значение в соседнюю  ячейку.
Для этого я использую код
Код
Worksheets(baza).Cells(cell, 114).Value = Worksheets("условия").Cells(j, 1).Value
Однако, этот код оставляет столбец 114 пустым.

при записи как ниже все работает. Но при такой записи найденные значения вписываются в ячейку, в которой производился поиск.
Код
Cell.Value =  Worksheets("условия").Cells(j, 1).Value
А мне нужно, чтобы они записывались в соседнюю ячейку. Как правильно записать эту строку?
Код
     For Each cell In Worksheets(baza).Range(Worksheets(baza).Cells(col, obsh), Worksheets(baza).Cells(bLastRow, obsh)).SpecialCells(xlCellTypeVisible)
 
    N = 0
        
        For j = 2 To jLastRow
 
If InStr(1, cell.Value, Worksheets("условия").Cells(j, 1).Value, 1) > 0 Then

If N = 0 Then

Worksheets(baza).Cells(cell, 114).Value = Worksheets("условия").Cells(j, 1).Value


N = 1


End If
End If
        Next j
        Next cell
 
Перейти    
Настройка строки формул в MS Excel
 
#
20.07.2017 09:42:41
Добрый день! Мне необходимо проставить параметры изделия исходя из его описания. Хочу, чтобы при редактировании одной строки, в строке формул ( сверху ) отображался определенный столбец ( столбец описания ). То есть чтобы значение этого столбца в этой строке отображалось в строке формул  в независимости от перемещения курсора в пределах строки. Извините за мудреное описание. Есть ли возможность это сделать?
 
Перейти    
Редактирование UserForm
 
#
19.07.2017 12:32:47
Всем привет! Не могу найти где в редакторе VBA открыть созданную ранее UserForm для редактирования. Подскажите пожалуйста
 
Перейти    
Замена значений через VBA
 
#
11.07.2017 17:21:32
Всем привет! В одном из столбцов таблицы записаны числа формата "800.00; 1000.63; 123.45;0;.... То есть их десятичная часть отделена точкой. Мне нужно заменить эту точку на запятую.
Сейчас использую следующий код:

Пока что получается, что после замены точки на запятую, получаю следующий столбец: "800;100063; 123,45;0,00;...    Запятая видна только у нуля. Что может быть не так?
Код
Range("T1:T" & iLastRow).NumberFormat = "@"
    Columns("T:T").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
  
 
Перейти    
Расширенный фильтр выбирает на все значения
 
#
10.07.2017 15:46:22
Добрый день! Столкнулся с такой проблемой. Есть макрос, который формирует таблицу с требуемым столбцами из таможенной базы данных. То есть вначале пользователь задает нужную ему шапку, и требуемый код товара по товарной номенклатуре. После чего запускает макрос, который фильтрует таможенную базу по требуемой товарной номенклатуре и выбирает из нее нужные пользователю столбцы. Проблема в следующем: если вручную отфильтровать базу через обычный фильтр, то количество строк почему-то отличается от того, что получается после отработки макроса.
Код макроса:
Код
Sub шапка()

     Dim i As Integer
     Dim j As Integer
     Dim k As Integer
     Dim iLastRow As Long
     Dim iLastCol As Long
     Dim jLastCol As Long
     Dim mLastRow As Long

    iLastRow = Worksheets("база").Cells(Rows.Count, 1).End(xlUp).Row
    mLastRow = Worksheets("справочник").Cells(Rows.Count, 1).End(xlUp).Row
        iLastCol = Worksheets("база").Cells(1, Columns.Count).End(xlToLeft).Column
    jLastCol = Worksheets("справочник").Cells(1, Columns.Count).End(xlToLeft).Column
   
Worksheets("база").Range("CJ1:CK" & iLastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
        :=Worksheets("справочник").Range(Worksheets("справочник").Cells(1, 1), Worksheets("справочник").Cells(mLastRow, 2)), Unique:=False




 For i = 1 To iLastCol

 For j = 3 To jLastCol + 2
 If Worksheets("база").Cells(1, i).Value = Worksheets("справочник").Cells(1, j).Value Then
 Worksheets("список").Cells(1, j - 2).Value = Worksheets("справочник").Cells(1, j).Value
 Worksheets("список").Cells(2, j - 2).Value = Worksheets("справочник").Cells(2, j).Value



Worksheets("база").Range(Worksheets("база").Cells(2, i), Worksheets("база").Cells(iLastRow, i)).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("список").Range(Worksheets("список").Cells(3, j - 2), Worksheets("список").Cells(iLastRow + 2, j - 2))



 End If
 Next j
Next i

Worksheets("справочник").Range(Worksheets("справочник").Cells(1, 3), Worksheets("справочник").Cells(1, jLastCol)).Copy _
Destination:=Worksheets("список").Range(Worksheets("список").Cells(1, 1), Worksheets("список").Cells(1, jLastCol - 2))


End Sub
Файл с шапкой таблицы в приложении

Может быть кто то сталкивался с подобной проблемой.  
 
Перейти    
Ошибка в работе расширенного фильтра
 
#
07.07.2017 16:03:51
Всем привет, есть расширенный фильтр, в коде vba я записываю условия для него и затем применяю к листу. Однако, каждый раз он выбирает из базы всего одну строку, что неправильно. Код фильтра ниже. В чем может быть ошибка?
Код
sub filter()

Worksheets("условие").Cells(1, 5).Value = "условие1"
Worksheets("условие").Cells(1, 6).Value = "условие2"
Worksheets("условие").Cells(2, 5).Value = "условие3*"
Worksheets("условие").Cells(3, 5).Value = "условие4*"
Worksheets("условие").Cells(4, 5).Value = "условие5*"
Worksheets("условие").Cells(5, 5).Value = "условие6*"
Worksheets("условие").Cells(6, 5).Value = "*условие7*"
Worksheets("условие").Cells(2, 6).Value = "="
Worksheets("условие").Cells(3, 6).Value = "="
Worksheets("условие").Cells(4, 6).Value = "="
Worksheets("условие").Cells(5, 6).Value = "="
Worksheets("условие").Cells(6, 6).Value = "="

iLastRow = Worksheets("sheet").Cells(Rows.Count, 1).End(xlUp).Row


  
    Worksheets("sheet").Range("AP2:BW" & iLastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
   :=Worksheets("условие").Range(Worksheets("условие").Cells(1, 5), Worksheets("условие").Cells(6, 6)), Unique:=False
           
           
Worksheets("sheet").UsedRange.Range("BW2:BW" & iLastRow).SpecialCells(xlCellTypeVisible) = "прочие"
    
    Worksheets("sheet").ShowAllData

end sub
 
Перейти    
Узнать путь к файлу и применить фильтр к его ячейке
 
#
06.07.2017 12:45:54
Здравствуйте! Мне нужно через диалоговое окно узнать путь к файлу, а затем применить фильтр к его ячейкам. На данным момент имею следующий код
Код
 
Sub фильтр()

 baza = Application.GetOpenFilename _
   ("Excel files(*.xls*),*.xls*", 2, "Введите файл, в который будут скопированы данные", , True)

 mes = Application.GetOpenFilename _
   ("Excel files(*.xls*),*.xls*", 2, "Выберите файл с базой за месяц", , True)

  iLastRow = Workbooks(mes).Worksheets("sheet").Cells(Rows.Count, 1).End(xlUp).Row
       

      Workbooks(mes).Worksheets("sheet").Range("BW2:BW" & iLastRow).AutoFilter Field:=75, Criteria1:=Array( _
        "тва", "тва проч"), Operator:=xlFilterValues


  Workbooks(mes).Worksheets("sheet").Range("A2:BW" & iLastRow).SpecialCells(xlCellTypeVisible).Copy
  
      Workbooks(baza).Worksheets("sheet").Paste
При выполнении макрос появляется ошибка "13. Type mismatch" на строке
Код
  Workbooks(mes).Worksheets("sheet").Range("BW2:BW" & iLastRow).AutoFilter Field:=75, Criteria1:=Array( _
        "тва", "тва проч"), Operator:=xlFilterValues
Это похоже связано с тем, что я неправильно указываю путь к файлу через  mes. Подскажите, как указать правильно.  
 
Перейти    
Разделение данных в ячейке VBA
 
#
09.06.2017 11:06:50
Всем привет! Мне нужно разделить текст из одной ячейки на несколько при помощи кода VBA. Никак не могу найти подходящий код.
Вначале я заполняю эту ячейку через следующий код:
Код
year = InputBox("Введите года, которые хотите заменить ( через пробел, например 2015,2016,2013 )", Title)
If year <> "" Then

Else: MsgBox "Вы не ввели данные!"

End If
Потом мне нужно будет рассматривать каждый год как отдельное условие  для фильтра. То есть нужно записать каждый год в отдельную переменную. Подскажите пожалуйста.
 
Перейти    
Копирование диапазона с одного листа на другой
 
#
11.05.2017 12:10:39
Добрый день! Необходимо скопировать диапазон с одного листа на другой. При этом возникает ошибка в строке ниже. Подскажите, в чем может быть ошибка.
Код
Worksheets("справочник").Range(Cells(2, j), Cells(iLastRow, j)) = Worksheets("база").Range(Cells(2, i), Cells(iLastRow, i))
Код
    iLastRow = Worksheets("база").Cells(Rows.Count, 1).End(xlUp).Row
    iLastCol = Worksheets("база").Cells(1, Columns.Count).End(xlToLeft).Column
    jLastCol = Worksheets("справочник").Cells(1, Columns.Count).End(xlToLeft).Column

 For i = 1 To iLastCol
 For j = 1 To jLastCol 
If Worksheets("база").Cells(1, i).Value = Worksheets("справочник").Cells(1, j).Value Then
Worksheets("справочник").Range(Cells(2, j), Cells(iLastRow, j)) = Worksheets("база").Range(Cells(2, i), Cells(iLastRow, i))
End if
Next j
Next i
 
Перейти    
Не получается привязать положение флажка к вызову макроса, If Checkbox1.Value = True Then
 
#
16.03.2017 11:50:41
Добрый день! В книге Excel на отдельной странице "Инструкция" есть флажок, который называется "Исключить". Мне нужно, чтобы при установке флажка, в  общем макросе срабатывал следующий код:
Код
  If Worksheets("инструкция").OLEObjects("Исключить").Object.Value = 1 Then     
 Call Поиск_исключений      
 Else 
End If

Однако, при выполнении общего макроса, макрос "Поиск_исключений" срабатывает ВНЕ ЗАВИСИМОСТИ от положения флажка. Я пробовал писать вместо

Код
Object.Value = 1
Код
Object.Value = True

, также пробовал описывать свой флажок следующим кодом (вместо приведенного выше)

Код
If Worksheets("инструкция").Checkbox1.Value = True Then 
Call Поиск_исключений      Else End If
 
Перейти    
Ошибка "method range of object global failed", макрос
 
#
07.03.2017 11:03:01
Добрый день! При выполнении макроса возникает ошибка "method range of object global failed". Макрос предназначен для применение расширенного фильтра с произвольным количеством условий. Он должен определять последнюю строку и столбец в таблице условий и применять эти условия к фильтруемым данным.

Ошибка возникает в  строке
Код
    Range("AP2:AY" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
        :=ActiveSheet.Range(Cells(1, 2), Cells(mLastRow, mLastCol)), Unique:=False
Код макроса приведен ниже.
Код
Sub Macros1()

    Sheets("baza").Select
    sLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
     Sheets("macros").Select
    mLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    mLastCol = Cells(1, Columns.Count).End(xlToLeft).Column

    Application.CutCopyMode = False
    
    Range("AP2:AY" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
        :=ActiveSheet.Range(Cells(1, 2), Cells(mLastRow, mLastCol)), Unique:=False
       
 
        
           On Error Resume Next
        
             Sheets("baza").Select
    ActiveSheet.UsedRange.Range("AR3:AR" & LastRow).SpecialCells(xlCellTypeVisible) = "один"
    
    ActiveSheet.ShowAllData
End Sub
 
Перейти    
Макрос для копирования части содержимого ячейки
 
#
20.02.2017 11:20:08
Всем привет! Не могу понять как должен выглядеть код макроса, который бы копировал из ячейки определенные данные и вставлял их в пустую ячейку.
Например,  столбец выглядит следующим образом.

Код
Пластина 720х8,5-К56, АКПП тип 1  
Пластина 543х9,5-К52, АКПП тип 1
Пластина 364х7,0-К54, АКПП тип 1
Пластина 1080х4,3-К57, АКПП тип 1
Пластина 436х7,0-К56, АКПП тип 1

и далее около 100 подобных ячеек

Нужно, чтобы в числа 720, 543, 364, 1080, 436 записались в один столбец, числа 8,5; 9,5; 7,0; 4,3; 7,0 в другой, а К56, К52,К54.... в третий столбец. Подскажите, пожалуйста, как может выглядеть код.

Изменено: kudim - 20.02.2017 11:20:44
 
Перейти    
Запрет на редактирования непустых ячеек после использования макроса.
 
#
28.11.2016 12:08:38
Всем привет! У меня массив данных в таблице сортируется при помощи последовательности макросов. Общий макрос, для примера, выглядит так.
Код
Sub Макрос_3()
Call Макрос_1
Call Макрос_2
End Sub
Сами макросы предназначены для фильтрации через расширенный фильтр и присвоению отфильтрованным ячейкам определенных значений. Столбец AP изначально пустой, макрос записывает значения в него. Макросы приведены ниже.
Мне нужно, чтобы записанные Макросом_1 значения в столбец AP не могли быть изменены Макросом_2. То есть нужно установить защиту от редактирования непустых ячеек столбца AP и наоборот. Подскажите, как можно это сделать. ( Макросов на самом деле около 15 )
Код
Sub Макрос_2()



 Sheets("товар").Select
    
    Range("DO1") = "TOVAR"
    Range("DO2") = "* ГОСТ 12345*"
    Range("DO3") = "* ГОСТ 4633*"
    Range("DO4") = "* ГОСТ 1345345*"
    Range("DO5") = "* ГОСТ 3434*"


    
    Sheets("товар").Select
   
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Application.CutCopyMode = False
    Range("AY2:AY" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
        :=Range("DO1:DO5"), Unique:=False
           On Error Resume Next
    ActiveSheet.UsedRange.Range("AP3:AP" & LastRow).SpecialCells(xlCellTypeVisible) = "товар_456"
    
    ActiveSheet.ShowAllData
  
    Range("DO1") = "dop_op"
   
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Application.CutCopyMode = False
    Range("AZ2:AZ" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
        :=Range("DO1:DO5"), Unique:=False
           On Error Resume Next
    ActiveSheet.UsedRange.Range("AP3:AP" & LastRow).SpecialCells(xlCellTypeVisible) = "товар_456"
      ActiveSheet.ShowAllData

End Sub
Код
Sub Макрос_1()



 Sheets("товар").Select
    
    Range("DO1") = "TOVAR"
    Range("DO2") = "* ГОСТ 10704*"
    Range("DO3") = "* ГОСТ 10705*"
    Range("DO4") = "* ГОСТ 10706*"
    Range("DO5") = "* ГОСТ 30732*"
    Range("DO6") = "* ГОСТ 8696*"
    Range("DO7") = "* ГОСТ 20295*"
    Range("DO8") = "* A53ERW*"
    Range("DO9") = "* A53 ERW*"

    
    Sheets("товар").Select
   
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Application.CutCopyMode = False
    Range("AY2:AY" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
        :=Range("DO1:DO9"), Unique:=False
           On Error Resume Next
    ActiveSheet.UsedRange.Range("AP3:AP" & LastRow).SpecialCells(xlCellTypeVisible) = "товар_123"
    
    ActiveSheet.ShowAllData
  
    Range("DO1") = "dop_op"
   
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Application.CutCopyMode = False
    Range("AZ2:AZ" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
        :=Range("DO1:DO9"), Unique:=False
           On Error Resume Next
    ActiveSheet.UsedRange.Range("AP3:AP" & LastRow).SpecialCells(xlCellTypeVisible) = "товар_123"
      ActiveSheet.ShowAllData


End Sub
 
Перейти    
Макрос расширенного фильтра: код, подобный рабочему, не работает
 
#
17.11.2016 08:54:35
Привет всем. Есть два макроса, отличие между которыми состоит лишь в тексте для расширенного фильтра. При этом один из них работает как нужно, а другой не хочет работать, чтобы я не делал. Помогите, пожалуйста, найти ошибку. Код приведен ниже. Рабочий первый макрос
Код
Sub Поиск_Профильные_бесшовн_хд()


'
' Нержавейка1 Макрос
' поиск труб из нержавейки
 Sheets("база").Select
    Range("DO1") = "TOVAR"
    Range("DO2") = "* профильн*"
    Range("DO3") = "*квадр*"
    Range("DO4") = "*прямоуг*"
    Range("DO5") = "*овал*"
    Range("DO6") = "* прямокут*"

    Range("DP1") = "TOVAR"
    Range("DP2") = "<>*круг*"
    Range("DP3") = "<>*круг*"
    Range("DP4") = "<>*круг*"
    Range("DP5") = "<>*круг*"
    Range("DP6") = "<>*круг*"

    Range("DR1") = "TOVAR"
    Range("DR2") = "*бесшовн*"
    Range("DR3") = "*бесшовн*"
    Range("DR4") = "*бесшовн*"
    Range("DR5") = "*бесшовн*"
    Range("DR6") = "*бесшовн*"

    Range("DS1") = "TOVAR"
    Range("DS2") = "*холодно*"
    Range("DS3") = "*холодно*"
    Range("DS4") = "*холодно*"
    Range("DS5") = "*холодно*"
    Range("DS6") = "*холодно*"

    Sheets("база").Select
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Application.CutCopyMode = False
    Range("AY2:AY" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
        :=Range("DO1:DS6"), Unique:=False
    ActiveSheet.UsedRange.Range("AP3:AP" & LastRow).SpecialCells(xlCellTypeVisible) = "Бесшовные х/д"
    ActiveSheet.UsedRange.Range("AQ3:AQ" & LastRow).SpecialCells(xlCellTypeVisible) = "бесшовн.х/д."
  ActiveSheet.ShowAllData
End Sub

Код
Sub Поиск_Профильные_бесшовн_гк()
' Нержавейка1 Макрос
' поиск труб из нержавейки
 Sheets("база").Select 
    Range("DO1") = "TOVAR"
    Range("DO2") = "* профильн*"
    Range("DO3") = "*квадр*"
    Range("DO4") = "*прямоуг*"
    Range("DO5") = "*овал*"
    Range("DO6") = "* прямокут*"

    Range("DP1") = "TOVAR"
    Range("DP2") = "<>*круг*"
    Range("DP3") = "<>*круг*"
    Range("DP4") = "<>*круг*"
    Range("DP5") = "<>*круг*"
    Range("DP6") = "<>*круг*"

    Range("DR1") = "TOVAR"
    Range("DR2") = "*бесшовн*"
    Range("DR3") = "*бесшовн*"
    Range("DR4") = "*бесшовн*"
    Range("DR5") = "*бесшовн*"
    Range("DR6") = "*бесшовн*"

    Range("DS1") = "TOVAR"
    Range("DS2") = "*горяч*"
    Range("DS3") = "*горяч*"
    Range("DS4") = "*горяч*"
    Range("DS5") = "*горяч*"
    Range("DS6") = "*горяч*"

    Sheets("база").Select
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Application.CutCopyMode = False
    Range("AY2:AY" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
        :=Range("DO1:DS6"), Unique:=False
    ActiveSheet.UsedRange.Range("AP3:AP" & LastRow).SpecialCells(xlCellTypeVisible) = "Бесшовные г/к"
    ActiveSheet.UsedRange.Range("AQ3:AQ" & LastRow).SpecialCells(xlCellTypeVisible) = "бесшовн.г/к."
  ActiveSheet.ShowAllData
End Sub
Изменено: kudim - 17.11.2016 10:38:17
 
Перейти    
Ошибка "Нельзя установить свойство SpecialCell класса Range"
 
#
15.11.2016 15:10:57
Привет всем! Сделал макрос для расширенного фильтра. В части макроса, отвечающей за заполнение отфильтрованных ячеек, появляется ошибка "Нельзя установить свойство SpecialCell класса Range". Код ниже.
Код
Sub Ïîèñê_Ïðîôèëüíûå_áåñøîâí_ãê()


'
' Íåðæàâåéêà1 Ìàêðîñ
' ïîèñê òðóá èç íåðæàâåéêè
'

 Sheets("áàçà").Select
   
    
    Range("DO1") = "TOVAR"
    Range("DO2") = "* ïðîôèëüí*"
    Range("DO3") = "*êâàäð*"
    Range("DO4") = "*ïðÿìîóã*"
    Range("DO5") = "*îâàë*"
    Range("DO6") = "* ïðÿìîêóò*"
   
    
    Range("DP1") = "TOVAR"
    Range("DP2") = "<>*êðóã*"
    Range("DP3") = "<>*êðóã*"
    Range("DP4") = "<>*êðóã*"
    Range("DP5") = "<>*êðóã*"
    Range("DP6") = "<>*êðóã*"
  
    
    Range("DR1") = "TOVAR"
    Range("DR2") = "*áåñøîâí*"
    Range("DR3") = "*áåñøîâí*"
    Range("DR4") = "*áåñøîâí*"
    Range("DR5") = "*áåñøîâí*"
    Range("DR6") = "*áåñøîâí*"
   
    
    Range("DS1") = "TOVAR"
    Range("DS2") = "*ãîðÿ÷å*"
    Range("DS3") = "*ãîðÿ÷å*"
    Range("DS4") = "*ãîðÿ÷å*"
    Range("DS5") = "*ãîðÿ÷å*"
    Range("DS6") = "*ãîðÿ÷å*"
  
  
    Sheets("áàçà").Select
   ActiveSheet.ShowAllData
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Application.CutCopyMode = False
    Range("AY2:AY" & LastRow).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _
        :=Range("DO1:DS6"), Unique:=False
   ActiveSheet.UsedRange.Range("AP3:AP" & LastRow).SpecialCells(xlCellTypeVisible) = "Áåñøîâíûå ã/ê"
  ActiveSheet.UsedRange.Range("AQ3:AQ" & LastRow).SpecialCells(xlCellTypeVisible) = "áåñøîâí. ã/ê."
  ActiveSheet.ShowAllData
End Sub

Ошибка возникает на 4 и 3 строке снизу. Подскажите пожалуйста, в чем может быть проблема.
 
Перейти    
Макрос для изменения только видимых ячеек
 
#
10.11.2016 10:27:59
Привет! Пытаюсь создать макрос для изменения только отфильтрованных ячеек. Нужно чтобы макрос заменял содержимое этих ячеек ( строка i, столбец AP) на другое, одинаковое для всех. Однако, у меня получается изменить только первую ячейку ( i = 13 ). Помогите, пожалуйста, найти ошибку.
Код
Sub Zamena ()

i = 13
    For Each cell In Cells(i, "AP")
        If cell.EntireRow.Hidden = False Then
            cell.Value = "123"
            i = i + 1
        End If
    Next cell
End Sub
 
Перейти    
Макрос для фильтра с условиями "содержит" и "не содержит", фильтрация с условиями "содержит" и "не содержит"
 
#
08.11.2016 12:34:56
Всем привет! Мне нужен фильтр, который бы выбирал из одного столбца ( каждая ячейка столбца одержит последовательность слов ) те ячейки, в которых встречаются заданные слова ( одно или несколько ), но не встречаются другие слова ( исключения ).

Например, имеем три ячейки в столбце, в каждой из них последовательность слов:

белый  желтый  красный  синий  оранжевый  розовый  малиновый
белый  черный  оранжевый  бурый  фиолетовый  желтый
красный  фиолетовый  коричневый  белый  черный  синий  голубой

Нужны те ячейки столбца, в которых встречаются слова желтый и/или белый, но нет слова красный.

Когда произвожу выборку через расширенный фильтр,
="* желтый *"
="* белый *"
="<>* красный *"

фильтр работает неправильно, он просто отсеивает все ячейки, в которых есть слово "красный".

Подскажите пожалуйста, как можно устроить такую фильтрацию.
 
Перейти    
Страницы: 1
Наверх