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

Вход

Регистрация

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

 

= Мир MS Excel/Как заставить макрос работать по определенному диапазону? - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как заставить макрос работать по определенному диапазону? (Макросы/Sub)
Как заставить макрос работать по определенному диапазону?
pashatank Дата: Суббота, 18.08.2018, 08:56 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
Здравствуйте! Уважаемые форумчане помогите подправить макрос
Есть задача удалить лишние запятые, дубли и в конце текста, пример:

Бэмэво 3E46,,,, Бэмэво 5E34,,,,,
Бэмэво 1 E87,,,,,,,, Бэмэво 3 E90,,,,,,,,,

нашел такой макрос

[vba]
Код
Sub del_zap() '(t1 As String) As String
Dim t1 As String, s As Range

'ActiveSheet.Range(Cells(1, 1)).Activate
For Each s In ActiveSheet.UsedRange '.SpecialCells(xlCellTypeConstants)
'ActiveSheet.Range(Cells(1, 1)).Select

Set s = Cells.Find(What:=",", After:=ActiveCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If s Is Nothing Then Exit Sub
s.Activate

t1 = s.Text

If InStr(1, t1, ",", 1) > 0 Then

Dim d()
e = Split(t1, ",")
n = 0
For I = LBound(e) To UBound(e)
If Trim(e(I)) <> "" Then
If n = 0 Then ReDim d(1)
n = n + 1
ReDim Preserve d(n)
d(n) = Trim(e(I))
End If
Next I

s = Mid(Join(d, ", "), 2, Len(Join(d, ",")) + 2)

Else
s = t1
End If

Next

End Sub
[/vba]

но, он работает по всему листу, а мне надо его запустить только для определенного столбца к примеру Range("B2:B10000"), какую строчку и куда надо вставить для этого?
 
Ответить
СообщениеЗдравствуйте! Уважаемые форумчане помогите подправить макрос
Есть задача удалить лишние запятые, дубли и в конце текста, пример:

Бэмэво 3E46,,,, Бэмэво 5E34,,,,,
Бэмэво 1 E87,,,,,,,, Бэмэво 3 E90,,,,,,,,,

нашел такой макрос

[vba]
Код
Sub del_zap() '(t1 As String) As String
Dim t1 As String, s As Range

'ActiveSheet.Range(Cells(1, 1)).Activate
For Each s In ActiveSheet.UsedRange '.SpecialCells(xlCellTypeConstants)
'ActiveSheet.Range(Cells(1, 1)).Select

Set s = Cells.Find(What:=",", After:=ActiveCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If s Is Nothing Then Exit Sub
s.Activate

t1 = s.Text

If InStr(1, t1, ",", 1) > 0 Then

Dim d()
e = Split(t1, ",")
n = 0
For I = LBound(e) To UBound(e)
If Trim(e(I)) <> "" Then
If n = 0 Then ReDim d(1)
n = n + 1
ReDim Preserve d(n)
d(n) = Trim(e(I))
End If
Next I

s = Mid(Join(d, ", "), 2, Len(Join(d, ",")) + 2)

Else
s = t1
End If

Next

End Sub
[/vba]

но, он работает по всему листу, а мне надо его запустить только для определенного столбца к примеру Range("B2:B10000"), какую строчку и куда надо вставить для этого?
Автор - pashatank
Дата добавления - 18.08.2018 в 08:56
_Boroda_ Дата: Суббота, 18.08.2018, 13:30 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 17006
Репутация: 6667 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Я бы немного не так стал делать такую замену (поячеечная работа, в каждой ячейке посимвольная, Сплит-Джойны, редим массива, все это без отключения пересчета и обновления экрана, ... - короче, из пушки по воробьям и работать он у Вас на более-менее нормальном объеме будет долго), но да ладно, что нашли, то нашли. Тем более, что файла-примера нет.
По поводу вопроса -
замените [vba]
Код
Cells.Find
[/vba] на [vba]
Код
Range("B2:B10000").Find
[/vba]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЯ бы немного не так стал делать такую замену (поячеечная работа, в каждой ячейке посимвольная, Сплит-Джойны, редим массива, все это без отключения пересчета и обновления экрана, ... - короче, из пушки по воробьям и работать он у Вас на более-менее нормальном объеме будет долго), но да ладно, что нашли, то нашли. Тем более, что файла-примера нет.
По поводу вопроса -
замените [vba]
Код
Cells.Find
[/vba] на [vba]
Код
Range("B2:B10000").Find
[/vba]
Автор - _Boroda_
Дата добавления - 18.08.2018 в 13:30
pashatank Дата: Суббота, 18.08.2018, 18:16 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
неа, не сработало, выдает run-time error 13 type mismatch
дебаг сюда шлет
Set s = Range("I2:I100").Find(What:=",", After:=ActiveCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
на последнюю строчку

приложил пример

[moder]Нарушение в части тегов п.3 Правил форума. Замечание[/moder]
К сообщению приложен файл: BMW_10_08_18.xls (48.0 Kb)
 
Ответить
Сообщениенеа, не сработало, выдает run-time error 13 type mismatch
дебаг сюда шлет
Set s = Range("I2:I100").Find(What:=",", After:=ActiveCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
на последнюю строчку

приложил пример

[moder]Нарушение в части тегов п.3 Правил форума. Замечание[/moder]
Автор - pashatank
Дата добавления - 18.08.2018 в 18:16
_Boroda_ Дата: Воскресенье, 19.08.2018, 00:04 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 17006
Репутация: 6667 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
Я предупреждал про Правила? Предупреждал
Ловите предпоследнее замечание и бан на 2 дня для прочтения Правил

А ругается макрос правильно - у Вас данные в столбце В, а ищете Вы почему-то в столбце I

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеЯ предупреждал про Правила? Предупреждал
Ловите предпоследнее замечание и бан на 2 дня для прочтения Правил

А ругается макрос правильно - у Вас данные в столбце В, а ищете Вы почему-то в столбце I
Автор - _Boroda_
Дата добавления - 19.08.2018 в 00:04
pashatank Дата: Среда, 22.08.2018, 14:20 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
Да нет,
 
Ответить
СообщениеДа нет,
Автор - pashatank
Дата добавления - 22.08.2018 в 14:20
pashatank Дата: Среда, 22.08.2018, 14:20 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
Да нет, я уже при заливке файла столбцы поменял, надо было предупредить

[vba]
Код
Sub del_zap() '(t1 As String) As String
Dim t1 As String, s As Range

'ActiveSheet.Range(Cells(1, 1)).Activate
For Each s In ActiveSheet.UsedRange '.SpecialCells(xlCellTypeConstants)
'ActiveSheet.Range(Cells(1, 1)).Select

Range("B1:B10000").Find(What:=",", After:=ActiveCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If s Is Nothing Then Exit Sub
s.Activate
[/vba]

Ругается либо на sintax error либо на то, что не хватает знака =, помогите понять, что не так?


Сообщение отредактировал pashatank - Среда, 22.08.2018, 14:26
 
Ответить
СообщениеДа нет, я уже при заливке файла столбцы поменял, надо было предупредить

[vba]
Код
Sub del_zap() '(t1 As String) As String
Dim t1 As String, s As Range

'ActiveSheet.Range(Cells(1, 1)).Activate
For Each s In ActiveSheet.UsedRange '.SpecialCells(xlCellTypeConstants)
'ActiveSheet.Range(Cells(1, 1)).Select

Range("B1:B10000").Find(What:=",", After:=ActiveCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If s Is Nothing Then Exit Sub
s.Activate
[/vba]

Ругается либо на sintax error либо на то, что не хватает знака =, помогите понять, что не так?
Автор - pashatank
Дата добавления - 22.08.2018 в 14:20
_Boroda_ Дата: Среда, 22.08.2018, 15:16 | Сообщение № 7
Группа: Админы
Ранг: Местный житель
Сообщений: 17006
Репутация: 6667 ±
Замечаний: ±

2003; 2007; 2010; 2013 RUS
А куда Вы Set дели?
И да, я не совсем правильно Вам подсказал. Там Вы ж выше еще диапазон определяете. Короче, вот так (принцип работы не менял)
[vba]
Код
Sub del_zap() '(t1 As String) As String
    Dim t1 As String, s As Range
    For Each s In Range("B2:B77") '.SpecialCells(xlCellTypeConstants)
        If InStr(s.Value, ",") Then
            s.Activate
            t1 = s.Text
            If InStr(1, t1, ",", 1) > 0 Then
            Dim d()
            e = Split(t1, ",")
            n = 0
            For I = LBound(e) To UBound(e)
            If Trim(e(I)) <> "" Then
            If n = 0 Then ReDim d(1)
            n = n + 1
            ReDim Preserve d(n)
            d(n) = Trim(e(I))
            End If
            Next I
            s = Mid(Join(d, ", "), 2, Len(Join(d, ",")) + 2)
            Else
            s = t1
            End If
        End If
    Next
End Sub
[/vba]
К сообщению приложен файл: BMW_10_08_18_1.xls (64.0 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеА куда Вы Set дели?
И да, я не совсем правильно Вам подсказал. Там Вы ж выше еще диапазон определяете. Короче, вот так (принцип работы не менял)
[vba]
Код
Sub del_zap() '(t1 As String) As String
    Dim t1 As String, s As Range
    For Each s In Range("B2:B77") '.SpecialCells(xlCellTypeConstants)
        If InStr(s.Value, ",") Then
            s.Activate
            t1 = s.Text
            If InStr(1, t1, ",", 1) > 0 Then
            Dim d()
            e = Split(t1, ",")
            n = 0
            For I = LBound(e) To UBound(e)
            If Trim(e(I)) <> "" Then
            If n = 0 Then ReDim d(1)
            n = n + 1
            ReDim Preserve d(n)
            d(n) = Trim(e(I))
            End If
            Next I
            s = Mid(Join(d, ", "), 2, Len(Join(d, ",")) + 2)
            Else
            s = t1
            End If
        End If
    Next
End Sub
[/vba]
Автор - _Boroda_
Дата добавления - 22.08.2018 в 15:16
pashatank Дата: Среда, 22.08.2018, 16:11 | Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 58
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010
Уважаемый Boroda, спасибо Вам большое за решение моего вопроса!
 
Ответить
СообщениеУважаемый Boroda, спасибо Вам большое за решение моего вопроса!
Автор - pashatank
Дата добавления - 22.08.2018 в 16:11
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как заставить макрос работать по определенному диапазону? (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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