Сообщения

 Уважаемый Viktor27!

Отправляю Вам макрос,который вставляет 10 формул в столбец D,
вставляет уникальные значения из  столбца A в столбец C
Макрос работает при любом количестве фамилий в столбце A.
 

Код Выделить Развернуть

Sub incert_formulas()
Dim c As Range, i As Variant, j1&, j2&, m&
Dim V As New Collection
 j1 = Range("A1").End(xlDown).Row
On Error Resume Next
  For Each c In Range("A1:A" & j1)
     V.Add c, c
  Next c
On Error GoTo 0
 For Each i In V
  m = m + 1: Range("C" & m) = i
 Next i
 j2 = Range("C1").End(xlDown).Row
 For m = 1 To 10
   Range("D" & m).Formula = "=INDEX($C$1:$C$" & j2 & ",RANDBETWEEN(1," & j1 + 1 & "))"
 Next m
 Columns("C:D").EntireColumn.AutoFit
End Sub

Уважаемый IsaacRampany  Вот работающий код пользовательской функции создателя кода Alex_Gur:
В любой ячейке вводите = S .Выскочит диалоговое окно.Выберите функцию и введите диапазон в круглые скобки:
Другой момент: текст, уже подпрограмм, уважаемого Alex_Gur можно сократить по длине в 2 раза.

Код (vb) Выделить Развернуть

Function StagRaboty(rngStag As Range)
Dim Come As Range
Dim Went As Range
Dim Stag01 As Long
Dim x As Long
Dim Year1 As Integer
Dim Mon1 As Integer
Dim Day1 As Integer
Dim Stag2 As String
Application.Volatile True
Range("A2").Select
Set Come = rngStag.Columns(1)
Set Went = rngStag.Columns(2)
Stag01 = Application.Sum _
(Went) - Application.Sum(Come)
Year1 = Application.RoundDown _
(Stag01 / 365, 0)
x = Stag01 - Year1 * 365
Mon1 = Application.RoundDown _
(x / 30, 0)
Day1 = x - Mon1 * 30
Stag2 = "Общий стаж равен " & Year1 & "лет " & Mon1 & " месяцев и " & Day1 & " дней "
StagRaboty = Stag2
End Function

Alex_Gur!
Вы предложили мне сообщить текст кода с учетом моего сообщения Вам
для Вашей пользовательской функции VBA:

 

Код (vb) Выделить Развернуть

Function StagRaboty(rngStag As Range)
Dim Come As Range
Dim Went As Range
Dim Stag01 As Long
Dim x As Long
Dim Year1 As Integer
Dim Mon1 As Integer
Dim Day1 As Integer
Dim Stag2 As String
Application.Volatile True
Range("A2").Select
Set Come = rngStag.Columns(1)
Set Went = rngStag.Columns(2)
Stag01 = Application.Sum _
(Went) - Application.Sum(Come)
Year1 = Application.RoundDown _
(Stag01 / 365, 0)
x = Stag01 - Year1 * 365
Mon1 = Application.RoundDown _
(x / 30, 0)
Day1 = x - Mon1 * 30
Stag2 = "Общий стаж равен " & Year1 & "лет " & Mon1 & " месяцев и " & Day1 & " дней "
StagRaboty = Stag2
End Function

Alex_Gur! Предлагаю такой вариант Вашего кода:
Я имею ввиду только пользовательскую функцию,которую можно
использовать в любой ячейке листа,отдельно от подпрограммы типа  Sub End Sub

Код (vb) Выделить Развернуть

Function StagRaboty(As Range) 
    Dim Come As Range 
    Dim Went As Range 
    Dim stag01 As Long 
    Dim x As Long 
    Dim Year1 As Integer 
    Dim Mon1 As Integer 
    Dim Day1 As Integer 
    Dim Stag2 As String
    Application.Volatile TRUE
    Range(Selection, Selection.End(xlDown)).Select 
    Set rngStag1 = Range(Selection, Selection.End(xlToRight)) 
    rngStag1.Select 
    Set Come = rngStag1.Columns(1) 
    Set Went = rngStag1.Columns(2) 
    stag01 = Application.Sum(Went) - Application.Sum(Come) 
    Year1 = Application.RoundDown(stag01 / 365, 0) 
    x = stag01 - Year1 * 365 
    Mon1 = Application.RoundDown(x / 30, 0) 
    Day1 = x - Mon1 * 30 
    Stag2 = Year1 & " лет " & Mon1 & " мес. " & Day1 & " дн." 
StagRaboty=Stag2
End Function 

    Уважаемый создатель кода вышеуказанной пользовательской функции VBA, Alex_Gur!
Почему Вы в коде  пользовательской функции нарушаете обязательный общепринятый синтаксис:
Когда функция завершает работу,ее результатом является значение,присваиваемое имени функции
У Вас в коде пользовательской функции, например, в строке 9 отсутствует выражение:
StagRaboty = Stag2
Кроме того добавьте в код пользовательской функции(например,в строку 10), пожалуйста, выражение:
  Application. Volatile TRUE:
Вы заставите функцию пересчитываться каждый раз при изменении любой ячейки.
И это не все...

Добавляю макрос,который вставляет формулы массива во все ячейки диапазона K3:N5,используя цикл:

 

Код (vb) Выделить Развернуть

Sub trend3()
Dim i As Integer
For i = 3 To 5
    Range("K" & i).FormulaArray = _
        "=INDEX(C1:C11,MAX(IF(B3:B11 = J" & i & ",ROW(B3:B11))))"
        Range("L" & i).FormulaArray = _
        "=INDEX(D1:D11,MAX(IF(B3:B11 = J" & i & ",ROW(B3:B11))))"
        Range("M" & i).FormulaArray = _
        "=INDEX(E1:E11,MAX(IF(B3:B11 = J" & i & ",ROW(B3:B11))))"
        Range("N" & i).FormulaArray = _
        "=INDEX(F1:F11,MAX(IF(B3:B11 = J" & i & ",ROW(B3:B11))))"
Next i
End Sub

Ваш случай решает улучшенная подпрограмма VBA:

 

Код (vb) Выделить Развернуть

Sub trend1()
Dim i As Integer, j As Integer, k As Integer
  For i = 3 To 5
    k = 2
  For j = 3 To 11
      If Range("J" & i).Value = Range("B" & j).Value And Range("B" & j).Row > k Then
          k = Range("B" & j).Row
          Range("K" & i & ":N" & i).Value = Range("C" & k & ":F" & k).Value
      End If
  Next j
Next i
End Sub

Добрый день!
В вашем случае правильнее использовать подпрограмму VBA Sub ...End Sub.
ūЕсли Вы хотите создать пользовательскую функцию VBA,
то она всегда заканчивается именем функции,типа cnt=,если имя ее например cnt
В ячейке набираете=c,выскочит контектсное меню,выбираете в нем свою функцию двойным щелчком мыши.Можно вызывать пользовательскую функцию и из подпрограммы .
В вашем случае правильнее использовать подпрограмму VBA:
 

Код (vb) Выделить Развернуть

Sub Cnt ()
Dim i As Integer
     For i=1 To 10
          Range ("B" & i)= Range("A"  & i)+1
     Next i
End Sub

Здравствуйте, вашу проблему также решает макрос, который вам высылаю

Код (vb) Выделить Развернуть

Sub макрос29()
Dim i As Integer, j As Integer, s As Integer
For j = 7 To 9
 s = 0
For i = 2 To 17
   If Range("F" & j) = Range("A" & i) Then
      s = s + Range("B" & i) * Range("C" & i)
   End If
Next i
 Range("G" & j) = s
Next j
End Sub