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

Вход

Регистрация

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

 

= Мир MS Excel/Применение макроса для динамического диапазона - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Применение макроса для динамического диапазона (Макросы/Sub)
Применение макроса для динамического диапазона
Max16 Дата: Вторник, 24.05.2016, 18:05 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Приветствую Вас всех, уважаемые форумчане!

Хотелось бы просить Вас о помощи в разрешения затруднения с которым я столкнулся при написании макроса. Для Вас задача, скорее всего покажется тривиальной, но не судите строго, я начал пользоваться VBA только недавно и еще много предстоит узнать и изучить.

Итак собственно в чем трудность: написал я макрос который должен выбирать определенные знаки в строке (с 6 по 10), и в зависимости от состава этих знаков выводится информация в соседний столбец. Думаю лучше показать макрос (так же прикладываю пример в файле):
[vba]
Код

Sub Макрос()
Dim a As String
a = Mid(Range("B6"), 6, 4)
If a = "2615" Then
Range("C6") = "т"
ElseIf a = "361B" Then
Range("C6") = "а"
ElseIf a = "1615" Then
Range("C6") = "б"
ElseIf a = "161B" Then
Range("C6") = "в"
ElseIf a = "2617" Then
Range("C6") = "г"
ElseIf a = "261F" Then
Range("C6") = "д"
ElseIf a = "G61F" Then
Range("C6") = "е"
End if
End sub
[/vba]

Макрос вполне себе рабочий, но нужно этот макрос растянуть на динамический диапазон (столбец C в примере). И вот здесь то я и столкнулся с проблемой. Как растянуть макрос записанный для конкретной ячейки я знаю. А вот здесь, к сожалению никак не могу справиться. Понимаю что скорее всего нужно применить цикл: For... Next. Но мои попытки это сделать не увенчались успехом.

Если у кого то есть представления что необходимо предпринять, буду благодарен за помощь)
К сообщению приложен файл: __.xlsm (20.5 Kb)

123

Сообщение отредактировал Max16 - Вторник, 24.05.2016, 21:57
 
Ответить
СообщениеПриветствую Вас всех, уважаемые форумчане!

Хотелось бы просить Вас о помощи в разрешения затруднения с которым я столкнулся при написании макроса. Для Вас задача, скорее всего покажется тривиальной, но не судите строго, я начал пользоваться VBA только недавно и еще много предстоит узнать и изучить.

Итак собственно в чем трудность: написал я макрос который должен выбирать определенные знаки в строке (с 6 по 10), и в зависимости от состава этих знаков выводится информация в соседний столбец. Думаю лучше показать макрос (так же прикладываю пример в файле):
[vba]
Код

Sub Макрос()
Dim a As String
a = Mid(Range("B6"), 6, 4)
If a = "2615" Then
Range("C6") = "т"
ElseIf a = "361B" Then
Range("C6") = "а"
ElseIf a = "1615" Then
Range("C6") = "б"
ElseIf a = "161B" Then
Range("C6") = "в"
ElseIf a = "2617" Then
Range("C6") = "г"
ElseIf a = "261F" Then
Range("C6") = "д"
ElseIf a = "G61F" Then
Range("C6") = "е"
End if
End sub
[/vba]

Макрос вполне себе рабочий, но нужно этот макрос растянуть на динамический диапазон (столбец C в примере). И вот здесь то я и столкнулся с проблемой. Как растянуть макрос записанный для конкретной ячейки я знаю. А вот здесь, к сожалению никак не могу справиться. Понимаю что скорее всего нужно применить цикл: For... Next. Но мои попытки это сделать не увенчались успехом.

Если у кого то есть представления что необходимо предпринять, буду благодарен за помощь)
Автор - Max16
Дата добавления - 24.05.2016 в 18:05
KuklP Дата: Вторник, 24.05.2016, 20:51 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
Ок.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Сообщение отредактировал KuklP - Среда, 25.05.2016, 05:37
 
Ответить
СообщениеОк.
Автор - KuklP
Дата добавления - 24.05.2016 в 20:51
Max16 Дата: Вторник, 24.05.2016, 22:17 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Добрый вечер, KuklP

К сожалению не добавил теги при создании темы - моя ошибка( Но обещаю - исправлюсь!

Буду Вам крайне признателен, если Вы поможете с решением моего затруднения.
P.S. (пол дня просидел, так и не смог сделать). Нужно конкретнее взяться за VBA

123
 
Ответить
СообщениеДобрый вечер, KuklP

К сожалению не добавил теги при создании темы - моя ошибка( Но обещаю - исправлюсь!

Буду Вам крайне признателен, если Вы поможете с решением моего затруднения.
P.S. (пол дня просидел, так и не смог сделать). Нужно конкретнее взяться за VBA
Автор - Max16
Дата добавления - 24.05.2016 в 22:17
RAN Дата: Вторник, 24.05.2016, 23:09 | Сообщение № 4
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[vba]
Код
Sub мяу()
    Dim arr1(), arr2()
    Dim i&, j&, k$
    arr1 = Array("2615", "361B", "1615", "161B", "2617", "261F", "G61F", "EC5F", "2A1F", "1617", "2G17", "4617", "2A1T", "CC5K", "361E", "FC5G", "561G", "661F", "6618", "661G", "6617", "FC58", "261B", "G617", "661F", "6A1F", "5G1F", "G618", "G61G", "EC5G", "2G1X", "6A1J", "3A1J")
    arr2 = Array("т", "а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "к", "л", "м", "н", "с", "т", "з", "у", "ц", "й", "х", "ю", "я", "ч", "ф", "щ", "ш", "м", "ы", "ь", "ъ", "н")
    For i = 6 To Cells(Rows.Count, "B").End(xlUp).Row
        k = Mid(Cells(i, "B"), 6, 4)
        For j = LBound(arr1) To UBound(arr1)
            If arr1(j) = k Then
                Cells(i, "B").Next = arr2(j)
                Exit For
            End If
        Next
    Next
End Sub
[/vba]

Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
Sub мяу()
    Dim arr1(), arr2()
    Dim i&, j&, k$
    arr1 = Array("2615", "361B", "1615", "161B", "2617", "261F", "G61F", "EC5F", "2A1F", "1617", "2G17", "4617", "2A1T", "CC5K", "361E", "FC5G", "561G", "661F", "6618", "661G", "6617", "FC58", "261B", "G617", "661F", "6A1F", "5G1F", "G618", "G61G", "EC5G", "2G1X", "6A1J", "3A1J")
    arr2 = Array("т", "а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "к", "л", "м", "н", "с", "т", "з", "у", "ц", "й", "х", "ю", "я", "ч", "ф", "щ", "ш", "м", "ы", "ь", "ъ", "н")
    For i = 6 To Cells(Rows.Count, "B").End(xlUp).Row
        k = Mid(Cells(i, "B"), 6, 4)
        For j = LBound(arr1) To UBound(arr1)
            If arr1(j) = k Then
                Cells(i, "B").Next = arr2(j)
                Exit For
            End If
        Next
    Next
End Sub
[/vba]
Автор - RAN
Дата добавления - 24.05.2016 в 23:09
KuklP Дата: Среда, 25.05.2016, 05:33 | Сообщение № 5
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация: 486 ±
Замечаний: 0% ±

2003-2010
[vba]
Код
Sub www()
    Dim dk As Object
    Set dk = CreateObject("scripting.dictionary")
    dk.Item("2615") = "т":    dk.Item("361B") = "а"
    dk.Item("1615") = "б":    dk.Item("161B") = "в"
    dk.Item("2617") = "г":    dk.Item("261F") = "д"
    dk.Item("G61F") = "е":    dk.Item("EC5F") = "ё"
    dk.Item("2A1F") = "ж":    dk.Item("1617") = "з"
    dk.Item("2G17") = "и":    dk.Item("4617") = "к"
    dk.Item("2A1T") = "л":    dk.Item("CC5K") = "м"
    dk.Item("361E") = "н":    dk.Item("FC5G") = "с"
    dk.Item("561G") = "т":    dk.Item("661F") = "з"
    dk.Item("6618") = "у":    dk.Item("661G") = "ц"
    dk.Item("6617") = "й":    dk.Item("FC58") = "х"
    dk.Item("261B") = "ю":    dk.Item("G617") = "я"
    dk.Item("661F") = "ч":    dk.Item("6A1F") = "ф"
    dk.Item("5G1F") = "щ":    dk.Item("G61G") = "м"
    dk.Item("EC5G") = "ы":    dk.Item("2G1X") = "ь"
    dk.Item("6A1J") = "ъ":    dk.Item("3A1J") = "н"
    For Each c In [b6:b81].Cells
        If dk.exists(Mid(c.Value, 6, 4)) Then c(1, 2) = dk.Item(Mid(c.Value, 6, 4))
    Next
    Set dk = Nothing
End Sub
[/vba]
К сообщению приложен файл: 0111686.xlsm (21.4 Kb)

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Сообщение отредактировал KuklP - Среда, 25.05.2016, 05:41
 
Ответить
Сообщение[vba]
Код
Sub www()
    Dim dk As Object
    Set dk = CreateObject("scripting.dictionary")
    dk.Item("2615") = "т":    dk.Item("361B") = "а"
    dk.Item("1615") = "б":    dk.Item("161B") = "в"
    dk.Item("2617") = "г":    dk.Item("261F") = "д"
    dk.Item("G61F") = "е":    dk.Item("EC5F") = "ё"
    dk.Item("2A1F") = "ж":    dk.Item("1617") = "з"
    dk.Item("2G17") = "и":    dk.Item("4617") = "к"
    dk.Item("2A1T") = "л":    dk.Item("CC5K") = "м"
    dk.Item("361E") = "н":    dk.Item("FC5G") = "с"
    dk.Item("561G") = "т":    dk.Item("661F") = "з"
    dk.Item("6618") = "у":    dk.Item("661G") = "ц"
    dk.Item("6617") = "й":    dk.Item("FC58") = "х"
    dk.Item("261B") = "ю":    dk.Item("G617") = "я"
    dk.Item("661F") = "ч":    dk.Item("6A1F") = "ф"
    dk.Item("5G1F") = "щ":    dk.Item("G61G") = "м"
    dk.Item("EC5G") = "ы":    dk.Item("2G1X") = "ь"
    dk.Item("6A1J") = "ъ":    dk.Item("3A1J") = "н"
    For Each c In [b6:b81].Cells
        If dk.exists(Mid(c.Value, 6, 4)) Then c(1, 2) = dk.Item(Mid(c.Value, 6, 4))
    Next
    Set dk = Nothing
End Sub
[/vba]
Автор - KuklP
Дата добавления - 25.05.2016 в 05:33
Max16 Дата: Среда, 25.05.2016, 11:04 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Уважаемые: KulkIP и RAN!

Благодарю Вас за помощь!
Оба варианта являются рабочими !

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

Еще раз спасибо за пути решения моей проблемы! Для меня это еще и необходимые знания ))

pray

123

Сообщение отредактировал Max16 - Среда, 25.05.2016, 11:06
 
Ответить
СообщениеУважаемые: KulkIP и RAN!

Благодарю Вас за помощь!
Оба варианта являются рабочими !

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

Еще раз спасибо за пути решения моей проблемы! Для меня это еще и необходимые знания ))

pray
Автор - Max16
Дата добавления - 25.05.2016 в 11:04
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Применение макроса для динамического диапазона (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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