Макрос на копирование цветного текста из ячеек одного столбца в ячейки другого

Автор AlexShelter, 26.03.2012, 16:58

« назад - далее »

AlexShelter

Ребята, спасайте...3к + записей и все откомментированы красным. Нужно из столбца С все комменты перенести в стобец АB. Помогите - помолюсь за Вас офисному богу))

Serge 007

Без макроса:
Выделяем столбец С, копируем, выделяем столбец АВ, ПКМ - специальная вставка - примечания.
Выделяем столбец С, ПКМ - Удалить примечание

А это макрорекордер записал:
Sub Макрос1()
    Columns("C:C").Select
    Selection.Copy
     Columns("AB:AB").Select
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Columns("C:C").Select
        Selection.ClearComments
End Sub
Бесплатная помощь: www.excelworld.ru
Платная помощь: sergeyizotov@excelworld.ru
Ю-money: 41001419691823 | WMR:126292472390


AlexShelter

эх, так не получается. Т.к. красный текст просто вписан в ячейку после основного текста.

andrey-750

Вот такой скриптик накропал...
Проверил - работает. Будут вопросы - обращайся!


Sub test9()
'
'
Dim _
MyText As String, _
RowNumMin, CnTr, J, StrLen, ColNumAB, ColNumC, RowNumMax, RowNum As Integer

    ColNumAB = 28
    ColNumC = 3
    RowNumMin = 4345 ' Номер первой строки     
    RowNumMax = 4354 ' Номер последней строки

For RowNum = RowNumMin To RowNumMax
    Cells(RowNum, ColNumC).Select
    StrLen = Len(Selection.Value)
    MyText = ""
    If StrLen > 1 Then
        For J = 1 To StrLen
'            MsgBox (Str(ActiveCell.Characters(Start:=J, Length:=1).Font.Color)) 'Раскомментируй эту строку, если потребуется определить код твоего красного цвета.
            If ActiveCell.Characters(Start:=J, Length:=1).Font.Color = 255 Then
             MyText = MyText & ActiveCell.Characters(Start:=J, Length:=1).Text
            End If
        Next
    End If
    Cells(RowNum, ColNumAB).Value = MyText
Next
End Sub