Страницы: Пред. 1 2
RSS
Форматировать ячейку с формулой с помощью макроса
 
нет
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Range("A8")
    .Value = "за период с " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 1, "[$-FC22]« D » MMMM 20 YY г.") & " по " & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 10, "[$-FC22]« D » MMMM 20 YY г.")
    a = Split(.Value, " ")
        For i = 0 To UBound(a)
            Select Case i
            Case 4, 6, 8, 12, 14, 16
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
With Range("A19")
.FormulaR1C1 = "=""1.1. Обязательство Субагента перед Агентом по перечислению выручки," _
& " полученной от реализации перевозок по договору №____ от « 28 » августа 20 20 года," _
& " составляет""&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R13C15&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R14C15&"",""&"" без НДС."""
.Formula = .Value
a = Split(.Value, " ")
b=0                                             ' Вот тут
        For i = 0 To UBound(a)
            Select Case i
            Case 0
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
End Sub
Изменено: Николай Павлов - 28.07.2021 18:14:28
По вопросам из тем форума, личку не читаю.
 
БМВ, к сожалению это не помогает, у меня все содержимое курсивом форматируется, уже не знаю что делать с этим, вас тоже замучил.
 
БМВ, вроде заработало.
 
я б на всякий случай сперва со всей ячейки снимал подчеркивание и курсив
По вопросам из тем форума, личку не читаю.
 
БМВ, спасибо вам большое, вы мне очень помогли.
 
БМВ, а как сделать в этом коде
Код
With Range("A19")
.FormulaR1C1 = "=""1.1. Обязательство Субагента перед Агентом по перечислению выручки," _
& " полученной от реализации перевозок по договору №___ от « 21 » августа 20 15 года," _
& " составляет""&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R13C15&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R14C15&"",""&"" без НДС."""
.Formula = .Value
a = Split(.Value, " ")
b=0                                             
        For i = 0 To UBound(a)
            Select Case i
            Case 0
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
так, чтобы форматировались слова не только разделенные пробелом, а ещё другим каким нибудь символом, допустим запятой или скобками?
Изменено: Николай Павлов - 28.07.2021 18:14:44
 
Код
With Range("A19")
.FormulaR1C1 = "=""1.1. Обязательство Субагента перед Агентом по перечислению выручки," _
& " полученной от реализации перевозок по договору №_____ от « 28 » августа 20 20 года," _
& " составляет""&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R13C15&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R14C15&"",""&"" без НДС."""
.Formula = .Value

Dim s As String
Dim v As Variant
s = .Value
For Each v In Array(",", "(", ")")
    s = Replace(s, v, " ")
Next

a = Split(s, " ")
b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 0
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
Изменено: Николай Павлов - 28.07.2021 18:14:57
 
в a = Split(Replace(.Value,",";" "), " ")  сперва заменить допустим запятую на пробел.
По вопросам из тем форума, личку не читаю.
 
А я бы в нужных местах вставил chr(160), и далее
Код
a = Split(s, chr(160))

И количество блоков сократится, и фрагменты с пробелом, типа "№13 – САГ" можно будет форматировать одним блоком.
 
RAN, Андрей, ну тогда можно  дойти до  вставить в нужных местах что-то невидимое и по нему делить, например сhr(28). Тут вопрос вкуса, простоты, наглядности .....
но тогда и дату сформированную где-то в другой ячейке тоже надо делить.....
По вопросам из тем форума, личку не читаю.
 
МатросНаЗебре, это код на данный момент у меня форматирует так "1.1. Обязательство Субагента перед Агентом по перечислению выручки, полученной от реализации перевозок по договору №____ от « 21 » августа 20 15 года, составляет 105 (сто пять рублей), без НДС". А мне нужно так "1.1. Обязательство Субагента перед Агентом по перечислению выручки, полученной от реализации перевозок по договору №19 – МАН от « 21 » августа 20 25 года, составляет 105 (сто пять рублей), без НДС."
Получается Case 26 форматирует 105, а когда добавляю 27, у меня форматируется так "1.1. Обязательство Субагента перед Агентом по перечислению выручки, полученной от реализации перевозок по договору №____ от « 28 » августа 20 15 года, составляет 105 (сто пять рублей), без НДС.", как сделать, чтобы форматировалось то, что находится в скобках, а "не без НДС."?
Код
.With Range("A19")
.FormulaR1C1 = "=""1.1. Обязательство Субагента перед Агентом по перечислению выручки," _
& " полученной от реализации перевозок по договору №____ от « 21 » августа 20 15 года," _
& " составляет""&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R13C15&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R14C15&"",""&"" без НДС."""
.FormulaR1C1 = .Value

Dim s As String
Dim v As Variant
s = .Value
For Each v In Array("(", ")")
    s = Replace(s, v, " ")
Next
a = Split(s, " ")
b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 26, 27
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
Изменено: Николай Павлов - 28.07.2021 18:15:25
 
В сообщении #39 было ж предложено решение.
Код
    With Range("A19")
        .FormulaR1C1 = """1.1. Обязательство Субагента перед Агентом по перечислению выручки," _
        & " полученной от реализации перевозок по договору №____ от « 28 » августа 20 20 года," _
        & " составляет""&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R13C15&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R14C15&"",""&"" без НДС."""
        .FormulaR1C1 = .Value
         
        Dim s As String
        Dim v As Variant
        s = .Value
        For Each v In Array("(", ")")
            s = Replace(s, v, Chr(160))
        Next
        Dim a As Variant
        a = Split(s, Chr(160))
        Dim b As Long
        Dim i As Long
        b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 1
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
Изменено: Николай Павлов - 28.07.2021 18:15:40
 
МатросНаЗебре, я вставил этот код, но почему то он выдаёт ошибку?
 
Код
    With Range("A19")
        .FormulaR1C1 = "=""1.1. Обязательство Субагента перед Агентом по перечислению выручки," _
        & " полученной от реализации перевозок по договору №_____ от « 28 » августа 20 20 года," _
        & " составляет""&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R13C15&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R14C15&"",""&"" без НДС."""
        .FormulaR1C1 = .Value
          
        Dim s As String
        Dim v As Variant
        s = .Value
        For Each v In Array("(", ")")
            s = Replace(s, v, Chr(160))
        Next
        'Dim a As Variant
        a = Split(s, Chr(160))
        Dim b As Long
        Dim i As Long
        b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 1
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
Изменено: Николай Павлов - 28.07.2021 18:15:50
 
МатросНаЗебре,
Код
With Range("A19")
        .FormulaR1C1 = "=""1.1. Обязательство Субагента перед Агентом по перечислению выручки," _
        & " полученной от реализации перевозок по договору №19 – МАН от « 21 » августа 20 15 года," _
        & " составляет""&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R13C15&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R14C15&"",""&"" без НДС."""
        .FormulaR1C1 = .Value
           
        Dim s As String
        Dim v As Variant
        s = .Value
        For Each v In Array("(", ")")
            s = Replace(s, v, Chr(160))
        Next
        'Dim a As Variant
        a = Split(s, Chr(160))
        Dim b As Long 'b As Long ошибку выдаёт
        Dim i As Long
        b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 1
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
Изменено: Ибрагим Белхороев - 26.07.2021 11:36:09
 
Удалите
Код
Dim b As Long 'b As Long ошибку выдаёт
Dim i As Long
 
МатросНаЗебре, Я, правда, имел ввиду немного не так
С формулой возиться лень, поэтому Value
Код
Sub Макрос1()
    With Range("A19")
'        .FormulaR1C1 = "=""1.1. Обязательство Субагента перед Агентом по перечислению выручки," _
'                       & " полученной от реализации перевозок по договору №___ от « 28 » августа 20 20 года," _
'                       & " составляет""&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R13C15&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R14C15&"",""&"" без НДС."""
        .FormulaR1C1 = "1.1. Обязательство Субагента перед Агентом по перечислению выручки, полученной от реализации перевозок по договору" & _
        Chr(160) & "№13 – САГ" & Chr(160) & "от « 28 » августа 20" & Chr(160) & "20" & Chr(160) & "года, составляет" _
        & Chr(160) & "105 (сто пять рублей)" & ", без НДС."

        Dim s As String
        Dim v As Variant
        s = Replace(Replace(Replace(Replace(.Value, "(", Chr(160)), ")", Chr(160)), Chr(171), Chr(160)), Chr(187), Chr(160))
'        For Each v In Array("(", ")")
'            s = Replace(s, v, " ")
'        Next
        a = Split(s, Chr(160))
        b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 1, 3, 5, 7, 8
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
    End With
End Sub
Изменено: Николай Павлов - 28.07.2021 18:16:07
 
МатросНаЗебре, если я правильно понял
Код
For Each v In Array("(", ")") 'форматируем то, что внутри скобки
Код
Case 1 ' форматируем все, что входит после открывающей скобки и до закрывающей
Код
Case 2 ' форматируем все, что следует после закрывающей скобки
а можно ещё добавить сюда пробел, чтобы форматировал символы разделенные пробелом при этом, форматирую то, что внутри скобок?
Код
For Each v In Array("(", ")"," ")
Изменено: Ибрагим Белхороев - 17.06.2021 15:06:28
 
БМВ, вы так имели в виду в сообщении #38?
Код
With Range("A19")
.FormulaR1C1 = "=""1.1. Обязательство Субагента перед Агентом по перечислению выручки," _
& " полученной от реализации перевозок по договору №___ от « 21 » августа 20 15 года," _
& " составляет""&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R13C15&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R14C15&"",""&"" без НДС."""
.Formula = .Value
a = Split(Replace(.Value, "(", " "), " ")
b = 0                                           
        For i = 0 To UBound(a)
            Select Case i
            Case 26, 27
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
Просто, так у меня форматируется в таком виде "1.1. Обязательство Субагента перед Агентом по перечислению выручки, полученной от реализации перевозок по договору №19 – МАН от « 19 » августа 20 15 года, составляет 210 (двести десять рублей), без НДС.", а как сделать так, чтобы форматировалось таким образом "1.1. Обязательство Субагента перед Агентом по перечислению выручки, полученной от реализации перевозок по договору №19 – МАН от « 21 » августа 20 15 года, составляет 210 (двести десять рублей), без НДС."
Изменено: Николай Павлов - 28.07.2021 18:16:24
 
МатросНаЗебре, можете помочь, сообщение #48?
 
Что-то мудрёное, с наскока не понял.
 
МатросНаЗебре, просто код в сообщении #44 форматирует только то, что в скобках, а мне нужно еще и другие символы, можно как то совместить, чтобы форматировалось, то что в скобках, так же символы разделенные пробелом?
 
a = Split(Replace(Replace(.Value, "(", " "),")"," ") " ")
Изменено: БМВ - 18.06.2021 10:45:35
По вопросам из тем форума, личку не читаю.
 
БМВ, в этой строке ошибка, она выделяется красным, как это исправить?
 
МатросНаЗебре, это код работает, форматируя то, что внутри скобок
Код
With Range("A19")        .FormulaR1C1 = "=""1.1. Обязательство Субагента перед Агентом по перечислению выручки," _
        & " полученной от реализации перевозок по договору №____ от « 21 » августа 20 15 года," _
        & " составляет""&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R13C15&"" ""&'[Реестр грузовых авианакладных копия1.xlsm]Итоговая декада'!R14C15&"",""&"" без НДС."""
        .FormulaR1C1 = .Value
            
        Dim s As String
        Dim v As Variant
        s = .Value
        For Each v In Array("(", ")")
            s = Replace(s, v, Chr(160))
        Next
        a = Split(s, Chr(160))
        b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 1
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
но мне нужно ещё чтобы форматировались символы разделенные пробелом и когда добавляю пробел в эту строку
Код
For Each v In Array("(", ")"," ")
у меня получается тогда, что эта строка
Код
Case 1
форматирует символы разделенные пробелом по порядку, начиная от нуля. Если задать Case 27, то форматируется то, что внутри скобок, но проблема, в том, что форматируется символы находящиеся в скобках, а также те символы, которые идут за ними, а мне нужно, чтобы форматировались символы заданные мною в Case.
Изменено: Николай Павлов - 28.07.2021 18:16:37
 
Цитата
Ибрагим Белхороев написал:
как это исправить?
выше подправил, случайно точку с запятой влепил  
По вопросам из тем форума, личку не читаю.
 
МатросНаЗебре, короче, вроде разобрался, спасибо всем, кто помогал.
Изменено: Ибрагим Белхороев - 18.06.2021 13:23:10
 
МатросНаЗебре, можете помочь, у меня дата в таком формате "№6 от 30 июня 20 21 г.", форматирую макросом хочу, чтобы "30 июня" было в таком виде "30 июня", вроде я в этой строке кода "For Each v In Array("от", "20")", указал, чтобы форматировалось то, что находится между "от" и "20", но в результате макрос форматирует так "№ 6 от 30 июня 20 21 г.", что я не так делаю?
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Range("A8")
.Value = "№" & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 1, "[$-FC22] M ") & "от" & Format(DateSerial(Year(Now), Month(Now) + 1, 1) - 1, "[$-FC22] D MMMM 20 YY г.")
Dim s As String
Dim v As Variant
s = .Value
For Each v In Array("от", "20")
    s = Replace(s, v, Chr(160))
Next
a = Split(s, Chr(160))
b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 1
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
End With
End Sub
Изменено: Ибрагим Белхороев - 24.06.2021 14:27:23
 
БМВ, Этот код у меня форматирует дату в таком виде: "№6 от 30 июня 20 21 г." получается, что у меня форматируются пробелы, которые после слова "от" и  перед числом "20". Как сделать так, чтобы эти пробелы не форматировались?
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)With Range("A8")
.Value = "№" & Format(DateSerial(Year(Now), Month(Now) + 0, 0) + 1, "[$-FC22]M") & " от " & Format(DateSerial(Year(Now), Month(Now) + 1, 1) - 1, "[$-FC22]D MMMM 20 YY г.")
Dim s As String
Dim v As Variant
s = .Value
For Each v In Array("т", "2")
    s = Replace(s, v, Chr(160))
Next
a = Split(s, Chr(160))
b = 0
        For i = 0 To UBound(a)
            Select Case i
            Case 1
                With .Characters(b + 1, Len(a(i))).Font
                    .Italic = True
                    .Underline = True
                End With
            End Select
            b = b + Len(a(i)) + 1
        Next
   End With
End Sub
Изменено: Ибрагим Белхороев - 25.06.2021 11:33:35
Страницы: Пред. 1 2
Наверх