Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1 2 След.
RSS
Удаление строк по заданному условию (кратность к опреденному числу)
 
#1
23.10.2014 12:28:57
Здравствуйте, ребята!
Имеется таблица с числовыми значениями. Данные значения представлены целыми и нецелыми числами. Я попробовал выделить нецелые числа и удалить строки, в которых они присутствуют. Для этого с помощью условного форматирования находил по формуле такие числа и окрашивал в красный цвет. Затем благоадря другой формуле я присваивал нецелым числам значение "-" в соседней ячейке и уже потом благодаря макросу удалял строки, где в первой ячейке содержался "-".
Как заменить условное форматирование и использование формулы на макрос? Поскольку таблица будет большой (строк будет более 5000). Чтобы обрабатывался весь лист.
И самое главное не смог сделать выявление чисел кратных определенному числу. Например, чтобы находились все числа, кратные 3, а все оставшиеся просто удалялись (точнее сами строки). Помогите пожалуйста. В макросах не силен.
 
 
 
#2
23.10.2014 12:33:01
Medvedoc, уточните условия удаления строк. Либо кратность определённому числу, либо удалять все строки с дробями, либо два макроса надо?

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#3
23.10.2014 12:35:51
по кратности чисел нашел вот такой пример на форуме. Но не знаю как его применить к своему документу. Тем более там формула, а нужен макрос. Здесь в первой ячейке задается число, которому все остальные должны быть кратны. И он подбирает все кратные числа. А мне надо, чтобы из диапазлна целых чисел остались только те, которые делятся без остатка на определенное число, то бишь кратные целому числу.
 
 
 
#4
23.10.2014 12:44:31
во-первых, условное форматирование + формула можно заменить на что-то одно из этого, и затем при помощи фильтра (по цвету или по значению) удалять.
во-вторых, не стоит перебирать весь миллион строк :)
Код
Public Sub HM()
' удаляем все дробные и целые, не кратные трём
'
lRow = Cells(Rows.Count, 2).End(xlUp).Row 'последняя заполненная во втором столбце
For i = lRow To 2 Step -1
    If Cells(i, 2).Value - Int(Cells(i, 2).Value) <> 0 Or Cells(i, 2).Value Mod 3 <> 0 Then Rows(i).Delete
Next i
End Sub
F1 творит чудеса
 
 
 
#5
23.10.2014 12:48:07
Макс, если строк под удаление много, лучше собрать их в "кучу" и удалять одним махом. Или одной махой))
 
 
 
#6
23.10.2014 12:50:47
JayBhagavan, суть в том, что таблица содержит значения целые и нецелые. При этом строки, содержащие нецелые числа просто надо удалить. Затем выбрать целые числа, которые кратны определенному числу (например, 3 - в принципе данное число можно задавать через ячейку). Все строки, в которых остались некратные целые числа должны также быть удалены.

Например:
1
2,5
4
8
1,3
Здесь первым шагом удаляются строки с цифрами 2,5 и 1,3 (нецелые числа). Вторым шагом определяем числа, кратные например 2. Соответственно это 4 и 8. Такие строки остаются, а строка с числом 1 удаляется (она не кратна 2). Вроде попытался описать  :)
 
 
 
#7
23.10.2014 12:51:44
,Максим Зеленский я не так силен в этом =)
 
 
 
#8
23.10.2014 12:53:52
Medvedoc, удаление дробных чисел. (раз уже сделал)
Код
Public Sub HM()
Const tCol% = 2
Const sRow% = 2
Dim i%, lRow%
lRow% = Cells.SpecialCells(xlCellTypeLastCell).Row
Application.ScreenUpdating = False
For i% = lRow% To sRow% Step -1
    If IsNumeric(Cells(i%, tCol%).Value) Then _
    If Cells(i%, tCol%).Value <> Int(Cells(i%, tCol%).Value) Then Rows(i).Delete
Next i%
Application.ScreenUpdating = True
End Sub

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#9
23.10.2014 12:56:58
JayBhagavan отлично =)
 
 
 
#10
23.10.2014 12:59:01
JayBhagavan а может попробовать в этот макрос вписать условие
например, берется число с конркетной одной ячейки и сравнивается вся таблица на кратность. И если не кратно просто удаляется? так нельзя?
 
 
 
#11
23.10.2014 13:00:30
я сначала пробовал как в файлике пример определять диапазон кратности определенному числу, потом сравнивал две таблицы и подсвечивал дупликаты. Но тогда я еще не мог удалять строки. Просто получалось все грамоздко.
 
 
 
#12
23.10.2014 13:03:40
Medvedoc, Вы макрос от уважаемого Максим Зеленский проверяли?

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#13
23.10.2014 13:06:28
Так будет быстрее:
Код
Sub qq()
    Dim i As Long, x As Range, a(): Application.ScreenUpdating = False
    Set x = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row): a = x.Value
    For i = 1 To UBound(a, 1)
        If a(i, 1) - Fix(a(i, 1)) <> 0 Or a(i, 1) Mod 3 <> 0 Then a(i, 1) = ""
    Next
    x.Value = a: x.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Чем шире угол зрения, тем он тупее.
 
 
 
#14
23.10.2014 13:08:14
Уважаемые JayBhagavan и Максим Зеленский дико извиняюсь за невнимательность. Все прекрасно работает =) Спасибо Вам ребята. Максим, а можно сделать так, чтобы число кратности можно было задавать через ячейку? например А1.
 
 
 
#15
23.10.2014 13:10:06
Medvedoc, возьмите на вооружение макрос от уважаемого SAS888 и вместо 3 (тройки), в пятой строке кода, запишите адрес ячейки, например,
[A1].Value

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#16
23.10.2014 13:13:58
Лучше присвоить переменной значение ячейки, содержащей делитель и использовать эту переменную. Это для того, чтобы макрос в цикле не обращался каждый раз к ячейке рабочего листа (что есть медленно).
Чем шире угол зрения, тем он тупее.
 
 
 
#17
23.10.2014 13:14:14
SAS888 к сожалению выдает ошибку run-time error '13'
 
 
 
#18
23.10.2014 13:17:20
JayBhagavan, совет с ячейкой на отлично сработал с макросом от Максима!  :)
 
 
 
#19
23.10.2014 13:27:44
SAS888, если нечего удалять, то ошибка № 1004.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#20
23.10.2014 13:29:56
Попробовал привести таблицу к нормальному виду. Использовал макрос Максима. Но теперь появилась ошибка. В чем причина?
 
 
 
#21
23.10.2014 13:33:39
Код
Sub HM()
' author SAS888, editor JayBhagavan
    Dim i As Long, x As Range, a(), krat, bClr As Boolean: Application.ScreenUpdating = False
    bClr = False
    krat = [A1].Value
    If Not IsNumeric(krat) Then Exit Sub
    Set x = Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row): a = x.Value
    For i = 1 To UBound(a, 1)
        If IsNumeric(a(i, 1)) Then _
        If a(i, 1) - Fix(a(i, 1)) <> 0 Or a(i, 1) Mod krat <> 0 Then a(i, 1) = "": bClr = True
    Next i
    If bClr Then x.Value = a: x.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Пробуйте.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#22
23.10.2014 13:36:29
Избежать многих возможных ошибок можно так:
Код
Sub qq()
    Dim i As Long, x As Range, a(): Application.ScreenUpdating = False
    Set x = Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row + 1): a = x.Value
    For i = 1 To UBound(a, 1)
        If Val(a(i, 1)) <> 0 Then
            If a(i, 1) - Fix(a(i, 1)) <> 0 Or a(i, 1) Mod 3 <> 0 Then a(i, 1) = ""
        Else: a(i, 1) = ""
        End If
    Next
    x.Value = a: x.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Т. е. забираем в массив всегда на одну строку больше, чем значений. Тогда всегда как минимум одна ячейка найдется. Также, добавил удаление строк с нечисловыми значениями (на всякий случай).
Чем шире угол зрения, тем он тупее.
 
 
 
#23
23.10.2014 13:40:42
Посмотрите пример во вложении. Активируйте требуемый лист и запустите макрос "qq".
Чем шире угол зрения, тем он тупее.
 
 
 
#24
23.10.2014 13:40:54
SAS888, удалять не числовые значения, имхо, в задание не входило, потому лучше этого не делать. И после отработки Вашего макроса кнопка автора в файле пропала у меня. :)

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#25
23.10.2014 13:43:46
JayBhagavan, SAS888, Максим Зеленский все получилось!!!
 
 
 
#26
23.10.2014 13:53:19
Юрий М, :) лениво было :) точнее, некогда - просто подчистил код автора. Поэтому гораздо корректнее, конечно же, код SAS888
F1 творит чудеса
 
 
 
#27
23.10.2014 13:53:22
Еще такой вопросик ребята, а как можно в виде настройки в отдельное окошко вынести кратность и кнопку? Но чтобы макрос при этом работал?
 
 
 
#28
23.10.2014 13:55:01
так а вы какой вариант макроса используете?
положите код сюда
F1 творит чудеса
 
 
 
#29
23.10.2014 14:04:02
Код
Sub HM()
' author SAS888, editor JayBhagavan
    Dim i As Long, x As Range, a(), krat, bClr As Boolean: Application.ScreenUpdating = False
    bClr = False
    krat = [C2].Value
    If Not IsNumeric(krat) Then Exit Sub
    Set x = Range("B5:B" & Cells(Rows.Count, 2).End(xlUp).Row): a = x.Value
    For i = 1 To UBound(a, 1)
        If IsNumeric(a(i, 1)) Then _
        If a(i, 1) - Fix(a(i, 1)) <> 0 Or a(i, 1) Mod krat <> 0 Then a(i, 1) = "": bClr = True
    Next i
    If bClr Then x.Value = a: x.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub


вот этот
 
 
 
#30
23.10.2014 14:09:08
рисуете кнопку
к ней цепляете макрос
5-ю строку кода меняете на это:
Код
krat=Application.Inputbox(Prompt:="Введите кратность (целое число)", Type:=1)
F1 творит чудеса
 
 
 
Страницы: 1 2 След.
Читают тему
Наверх