Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
если предположить, что мы говорим про Excel, то допустим у нас данные только в столбце А, начиная с ячейка А1 (и других данных в других столбцах нет), то
Код
Sub Test()
Dim arr As Variant, rowCounter As Long, i As Long
With ActiveSheet
arr = .Range("A1").CurrentRegion
ReDim arrOut(1 To UBound(arr), 1 To 1)
For i = LBound(arr) To UBound(arr)
If InStr(1, arr(i, 1), "-", vbTextCompare) > 0 Then
rowCounter = rowCounter + 1
arrOut(rowCounter, 1) = arr(i, 1)
End If
Next i
.Columns(3).Clear
.Range("C1").Resize(rowCounter, 1).Value = arrOut
End With
End Sub
согласен, ничего такого в исходных нет (это все моя больная фантазия - не более, плюс нежелание решать одну и туже задачу по несколько раз)
Код
Sub Test()
Dim a, r&, s$
a = [a1].CurrentRegion
For r = 1 To UBound(a)
s = s & FindWordWithDefis(a(r, 1))
Next
MsgBox s
End Sub
Function FindWordWithDefis$(txt)
Const Cir$ = "[а-яА-ЯёЁ]+"
Dim m, ms, re, s$
Set re = CreateObject("VBScript.RegExp")
re.Pattern = Cir & "-" & Cir
re.Global = True: re.MultiLine = True
If re.Test(txt) Then
Set ms = re.Execute(txt)
For Each m In ms: s = s & " " & m: Next
End If
FindWordWithDefis = s
End Function
Добрый вечер, Антон. Просто в макросе от Ігор Гончаренко результат макроса выводится в MsgBox - системное окно. Из него нельзя скопировать текст, оно информационное. Можно в его коде заменить вот эту строку
Код
MsgBox s
например, вот на эту
Код
Range("C1").Value = s
тогда результат работы макрос будет записан в ячейку С1