Суть вопроса: Есть таблица, в столбце В которой стоят единицы измерения в виде м2 м3 шт т кг и т.д. пример здесь. Мне необходимо привести из такого вида как ЕСТЬ, в вид который мне НУЖЕН.
Макрорекордером получил код, убрал ненужное и в итоге получился вполне рабочий код: [vba]
Код
Sub м2()
Range("B3").Select ActiveCell.FormulaR1C1 = "м2" With ActiveCell.Characters(Start:=1, Length:=1).Font .Subscript = False End With With ActiveCell.Characters(Start:=2, Length:=1).Font .Superscript = True End With
End Sub
[/vba]
Но этот код работает только на какую-либо указанную ячейку столбца "В", а мне нужно чтобы преобразование происходило по всему столбцу "В" и не только м2, но и м3. Пробовал выделять диапазон Range("B:В").Select - не работает... Подправьте пожалуйста макрос, чтобы во всем столбце В происходило преобразование м2 и м3 в нужный мне формат, при этом игнорировались все остальные надписи, пустые строки, а также объединенные строки. Таблица может быть очень длинной.
Файл-пример прицепляю.
Спасибо
Доброго дня, Уважаемые знатоки!
Суть вопроса: Есть таблица, в столбце В которой стоят единицы измерения в виде м2 м3 шт т кг и т.д. пример здесь. Мне необходимо привести из такого вида как ЕСТЬ, в вид который мне НУЖЕН.
Макрорекордером получил код, убрал ненужное и в итоге получился вполне рабочий код: [vba]
Код
Sub м2()
Range("B3").Select ActiveCell.FormulaR1C1 = "м2" With ActiveCell.Characters(Start:=1, Length:=1).Font .Subscript = False End With With ActiveCell.Characters(Start:=2, Length:=1).Font .Superscript = True End With
End Sub
[/vba]
Но этот код работает только на какую-либо указанную ячейку столбца "В", а мне нужно чтобы преобразование происходило по всему столбцу "В" и не только м2, но и м3. Пробовал выделять диапазон Range("B:В").Select - не работает... Подправьте пожалуйста макрос, чтобы во всем столбце В происходило преобразование м2 и м3 в нужный мне формат, при этом игнорировались все остальные надписи, пустые строки, а также объединенные строки. Таблица может быть очень длинной.
Sub м2() For Each cell In Selection p = InStr(cell, "м2") If p > 0 Then cell.Characters(Start:=p + 1, Length:=1).Font.Superscript = True p = InStr(cell, "м3") If p > 0 Then cell.Characters(Start:=p + 1, Length:=1).Font.Superscript = True Next End Sub
[/vba]
[vba]
Код
Sub м2() For Each cell In Selection p = InStr(cell, "м2") If p > 0 Then cell.Characters(Start:=p + 1, Length:=1).Font.Superscript = True p = InStr(cell, "м3") If p > 0 Then cell.Characters(Start:=p + 1, Length:=1).Font.Superscript = True Next End Sub
прохожий2019, Код работает, когда выделяю всю таблицу... это немного не то... можно как-то сделать без выделения всей таблицы, потому что таблица очень большая на 30-80 листов. Может как-то просто в коде указать диапазон "В:В" Или может For Counter = 1 To 120 Или For Each c In Worksheets("Лист1").Range("B:B").Cells
Спасибо
прохожий2019, Код работает, когда выделяю всю таблицу... это немного не то... можно как-то сделать без выделения всей таблицы, потому что таблица очень большая на 30-80 листов. Может как-то просто в коде указать диапазон "В:В" Или может For Counter = 1 To 120 Или For Each c In Worksheets("Лист1").Range("B:B").Cells
прохожий2019, Извините, но grh15708 это я же т.е. grh1... просто вчера как-то зашел нестандартно ... еще удивился своему нику, но не придал значения. А сегодня включил комп и зашел под своим логином, а зайти на grh15708 не могу, т.к. парольвчера даже не помню. Так что если можете, то ответьте пожалуйста на пост № 3.
Спасибо
прохожий2019, Извините, но grh15708 это я же т.е. grh1... просто вчера как-то зашел нестандартно ... еще удивился своему нику, но не придал значения. А сегодня включил комп и зашел под своим логином, а зайти на grh15708 не могу, т.к. парольвчера даже не помню. Так что если можете, то ответьте пожалуйста на пост № 3.
Sub ertM() 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]
grh1, привет попробуйте [vba]
Код
Sub ertM() 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
nilem, доброго дня! К сожалению Ваш код не совсем корректно работает, на бОльших портянках столбца "В". Прикрепляю файл, выполните Ваш код - увидим, что преобразование происходит через раз, плюс "кг" буква "г" улетает в надстрочку, иногда в "шт" буква "т" становится надстрочной. Подправьте пожалуйста.
Спасибо.
nilem, доброго дня! К сожалению Ваш код не совсем корректно работает, на бОльших портянках столбца "В". Прикрепляю файл, выполните Ваш код - увидим, что преобразование происходит через раз, плюс "кг" буква "г" улетает в надстрочку, иногда в "шт" буква "т" становится надстрочной. Подправьте пожалуйста.