Страницы: 1
RSS
Как автоматически проставить числовой индекс
 
Есть столбец с формулами вида С15H21Br3N2O2S (в столбце около 300 таких формул), можно ли автоматизировать перевод цифер в подстрочный индекс? Спасибо!
 
Евгений Кругликов, макрос работает с выделенным диапазоном, выделять можно строки, столбцы, весь лист целиком.
Код
Sub Ek()
Dim c As Range, re As Object, x
  Set re = CreateObject("vbscript.regexp")
  re.Pattern = "\d+"
  re.Global = True
  For Each c In Selection.SpecialCells(xlCellTypeConstants, xlTextValues)
    For Each x In re.Execute(c.Value)
      c.Characters(x.firstindex + 1, x.Length).Font.Subscript = True
    Next
  Next
End Sub
Изменено: Казанский - 22.03.2018 20:11:57
 
Спасибо! С макросами еще не работал, буду учиться.... :-)
 
Возможно ли написать подобный с следующими условиями: любая цифра с тире и обратным слешем не меняет формата (например 2-, -5, 1/2) а знак "+" или "+ с цифрой" (например +3) всегда надстрочный индекс, а все остальные цифры с буквами подстрочный индекс. Спасибо!
 
Off
Цитата
Евгений Кругликов написал:
С макросами еще не работал, буду учиться.
судя по всему не пошло :-)
По вопросам из тем форума, личку не читаю.
 
Цитата
Евгений Кругликов написал:
Возможно ли написать подобный с следующими условиями...
Возможно - с файлом-примером. Постарайтесь учесть все возможные варианты.
 
Пример
 
По мотивам макроса от Казанский, Собрать все это в один шаблон пока для меня сложно
Код
Sub Ek_Sanja()
Dim c As Range, re As Object, x, arrPatt()
Set re = CreateObject("vbscript.regexp")
re.Global = True
arrPatt = Array("\d+", "\+\d+|\+", "\d+\/\d+|-\d+|,\d+|\d+-[a-zA-Z]")
Application.ScreenUpdating = False
'Set myRange = Selection    'для выбранного диапазона
Set myRange = Worksheets("Лист1").Range("A2:A9").SpecialCells(xlCellTypeConstants, xlTextValues)
For Each c In myRange
    For I = 0 To UBound(arrPatt)
        re.Pattern = arrPatt(I)
        For Each x In re.Execute(c.Value)
            With c.Characters(x.firstindex + 1, x.Length).Font
                Select Case I
                    Case 0: .Subscript = True
                    Case 1: .Superscript = True
                    Case Else: .Subscript = False: .Superscript = False
                End Select
            End With
        Next
    Next
Next
Application.ScreenUpdating = True
End Sub
Изменено: Sanja - 06.04.2018 12:13:03
Согласие есть продукт при полном непротивлении сторон
 
Спасибо!!!
Страницы: 1
Наверх