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

Вход

Регистрация

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

 

= Мир MS Excel/из двух макросов, сделать один - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » из двух макросов, сделать один (Макросы/Sub)
из двух макросов, сделать один
grh1 Дата: Вторник, 23.11.2021, 13:48 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 233
Репутация: 0 ±
Замечаний: 40% ±

2019
Доброго дня, уважаемые знатоки VBA!

Подскажите пожалуйста, как объединить два макроса
1-й макрос - форматирует таблицу по границе страницы
[vba]
Код
Sub rast()

'ниженаписанный код растягивает столбец А по границе страницы с учетом других столбцов

Dim w, c&, i&, dw, noc
  c = ActiveSheet.VPageBreaks(1).Location.Column
  w = Columns(c).ColumnWidth
Do
    Columns(c).ColumnWidth = Columns(c).ColumnWidth / 2
    If Columns(c).ColumnWidth < 0.02 Then Exit Do
    DoEvents
  Loop Until ActiveSheet.VPageBreaks(1).Location.Column <> c
  noc = Columns(c).ColumnWidth < 0.02
  For i = 6 To c + IIf(noc, -1, 0)
    dw = dw + Columns(i).ColumnWidth
      
  Next
  If Columns(c).ColumnWidth <> w Then Columns(c).ColumnWidth = w
  Columns(1).ColumnWidth = Columns(1).ColumnWidth + dw

    
End Sub
[/vba]

2-й макрос преобразовывает м2 и м3 с надстрочной цифрой
[vba]
Код
Sub preobraz_m2_m3()

'ниженаписанный код преобразовывает цифры в словах м2 и м3 в надстрочные

    Dim x, i&
        x = Range("B1", Cells(Rows.Count, 2).End(xlUp)).Value
        For i = 1 To UBound(x)
            If x(i, 1) Like "?#" Then Cells(i, 2).Characters(2, 1).Font.Superscript = True
        Next i
    
End Sub
[/vba]

Конфликтует переменная i&, которая есть в первом макросе и во втором. Замена буквы i& ничего не дает.
Помогите пожалуйста. Файл прикладываю.

Спасибо
К сообщению приложен файл: 1708_new2.xls (36.0 Kb)

Vadym Gorokh
 
Ответить
СообщениеДоброго дня, уважаемые знатоки VBA!

Подскажите пожалуйста, как объединить два макроса
1-й макрос - форматирует таблицу по границе страницы
[vba]
Код
Sub rast()

'ниженаписанный код растягивает столбец А по границе страницы с учетом других столбцов

Dim w, c&, i&, dw, noc
  c = ActiveSheet.VPageBreaks(1).Location.Column
  w = Columns(c).ColumnWidth
Do
    Columns(c).ColumnWidth = Columns(c).ColumnWidth / 2
    If Columns(c).ColumnWidth < 0.02 Then Exit Do
    DoEvents
  Loop Until ActiveSheet.VPageBreaks(1).Location.Column <> c
  noc = Columns(c).ColumnWidth < 0.02
  For i = 6 To c + IIf(noc, -1, 0)
    dw = dw + Columns(i).ColumnWidth
      
  Next
  If Columns(c).ColumnWidth <> w Then Columns(c).ColumnWidth = w
  Columns(1).ColumnWidth = Columns(1).ColumnWidth + dw

    
End Sub
[/vba]

2-й макрос преобразовывает м2 и м3 с надстрочной цифрой
[vba]
Код
Sub preobraz_m2_m3()

'ниженаписанный код преобразовывает цифры в словах м2 и м3 в надстрочные

    Dim x, i&
        x = Range("B1", Cells(Rows.Count, 2).End(xlUp)).Value
        For i = 1 To UBound(x)
            If x(i, 1) Like "?#" Then Cells(i, 2).Characters(2, 1).Font.Superscript = True
        Next i
    
End Sub
[/vba]

Конфликтует переменная i&, которая есть в первом макросе и во втором. Замена буквы i& ничего не дает.
Помогите пожалуйста. Файл прикладываю.

Спасибо
Автор - grh1
Дата добавления - 23.11.2021 в 13:48
Pelena Дата: Вторник, 23.11.2021, 14:13 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19403
Репутация: 4555 ±
Замечаний: ±

Excel 365 & Mac Excel
[vba]
Код
Sub rast()

'ниженаписанный код растягивает столбец А по границе страницы с учетом других столбцов

    Dim w, c&, dw, noc
    Dim x, i&

    c = ActiveSheet.VPageBreaks(1).Location.Column
    w = Columns(c).ColumnWidth
    Do
        Columns(c).ColumnWidth = Columns(c).ColumnWidth / 2
        If Columns(c).ColumnWidth < 0.02 Then Exit Do
        DoEvents
    Loop Until ActiveSheet.VPageBreaks(1).Location.Column <> c
    noc = Columns(c).ColumnWidth < 0.02
    For i = 6 To c + IIf(noc, -1, 0)
        dw = dw + Columns(i).ColumnWidth

    Next
    If Columns(c).ColumnWidth <> w Then Columns(c).ColumnWidth = w
    Columns(1).ColumnWidth = Columns(1).ColumnWidth + dw

    x = Range("B1", Cells(Rows.Count, 2).End(xlUp)).Value
    For i = 1 To UBound(x)
        If x(i, 1) Like "?#" Then Cells(i, 2).Characters(2, 1).Font.Superscript = True
    Next i

End Sub
[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
Сообщение[vba]
Код
Sub rast()

'ниженаписанный код растягивает столбец А по границе страницы с учетом других столбцов

    Dim w, c&, dw, noc
    Dim x, i&

    c = ActiveSheet.VPageBreaks(1).Location.Column
    w = Columns(c).ColumnWidth
    Do
        Columns(c).ColumnWidth = Columns(c).ColumnWidth / 2
        If Columns(c).ColumnWidth < 0.02 Then Exit Do
        DoEvents
    Loop Until ActiveSheet.VPageBreaks(1).Location.Column <> c
    noc = Columns(c).ColumnWidth < 0.02
    For i = 6 To c + IIf(noc, -1, 0)
        dw = dw + Columns(i).ColumnWidth

    Next
    If Columns(c).ColumnWidth <> w Then Columns(c).ColumnWidth = w
    Columns(1).ColumnWidth = Columns(1).ColumnWidth + dw

    x = Range("B1", Cells(Rows.Count, 2).End(xlUp)).Value
    For i = 1 To UBound(x)
        If x(i, 1) Like "?#" Then Cells(i, 2).Characters(2, 1).Font.Superscript = True
    Next i

End Sub
[/vba]
Автор - Pelena
Дата добавления - 23.11.2021 в 14:13
grh1 Дата: Вторник, 23.11.2021, 14:52 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 233
Репутация: 0 ±
Замечаний: 40% ±

2019
Pelena, спасибо большое

Vadym Gorokh
 
Ответить
СообщениеPelena, спасибо большое
Автор - grh1
Дата добавления - 23.11.2021 в 14:52
Мир MS Excel » Вопросы и решения » Вопросы по VBA » из двух макросов, сделать один (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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