Как преобразовать предложения в столбец/строку из отдельных слов

#excel #vba

Вопрос:

Почему это не работает?

Печатает только первое слово, и я не знаю, как я могу изменить «10» в «Для» на что-то вроде «Для каждого слова в предложении».

 Sub Change()  Dim S As String  Dim i As Integer  Dim x As String      S = InputBox("Sentence")  x = Split(S, " ") For i = 1 To x  Cells(1, i).Value = Split(S, " ")    Next i   End Sub  

Комментарии:

1. Split сначала, затем зациклите результат массива Split .

2. @BigBen Что-то в этом роде? Но все равно не работает

Ответ №1:

Попробуй это:

 Public Sub Change()  Dim sentence As String: sentence = InputBox("Sentence")  Dim col As Long: col = 1  Dim word As Variant: For Each word In Split(sentence, " ")  ThisWorkbook.Worksheets("Sheet1").Cells(1, col).Value = word  col = col   1  Next End Sub  

Ответ №2:

Разделить предложение на рабочий лист

 Option Explicit  Sub SentenceToRow()  Const ProcTitle As String = "Sentence to Row"  Const First As String = "A1"    Dim S As Variant: S = InputBox("Input a Sentence", ProcTitle)  If Len(S) = 0 Then  MsgBox "You canceled.", vbExclamation, ProcTitle  Exit Sub  End If    Dim Strings() As String: Strings = Split(S)  Dim cCount As Long: cCount = UBound(Strings)   1    Dim ws As Worksheet: Set ws = ActiveSheet  Dim rg As Range: Set rg = ws.Range(First).Resize(, cCount)  rg.Value = Strings    MsgBox "Sentence split to a row.", vbInformation, ProcTitle  End Sub  Sub SentenceToColumn()  Const ProcTitle As String = "Sentence to Column"  Const First As String = "A1"    Dim S As Variant: S = InputBox("Input a Sentence", ProcTitle)  If Len(S) = 0 Then  MsgBox "You canceled.", vbExclamation, ProcTitle  Exit Sub  End If    Dim Strings() As String: Strings = Split(S)  Dim rCount As Long: rCount = UBound(Strings)   1    Dim ws As Worksheet: Set ws = ActiveSheet  Dim rg As Range: Set rg = ws.Range(First).Resize(rCount)  rg.Value = Application.Transpose(Strings)    MsgBox "Sentence split to a column.", vbInformation, ProcTitle  End Sub  

Ответ №3:

это быстро и эффективно:

 Sub testSplit2Row()  Dim frase As String  frase = "las palabras de amor"    Dim ary As Variant  ary = Split(frase, " ")    Dim dest As Range  Dim start As Range  Set start = Range("B1")  Set dest = start.Resize(UBound(ary)   1)  dest.Value = Application.Transpose(ary)    start.Resize(, UBound(ary)   1).Value = ary End Sub  

Ответ №4:

Если вы избавитесь от функций динамического массива MSExcel 365, вы можете извлечь выгоду из следующей функции, которую можно использовать, а также с помощью udf или с помощью кода.

Функция words() принимает значения диапазона, значения массива или явные строковые входные данные в качестве первого аргумента s ; второй аргумент IsVertical является необязательным и указывает, что по умолчанию результаты будут возвращены в виде вертикального массива (вместо «плоского» массива).

 Public Function words(ByVal s As Variant, Optional IsVertical As Boolean = True)  'Debug.Print VarType(s)  If VarType(s) gt;= vbArray Then  s = Replace(Application.WorksheetFunction.ArrayToText(s), ",", "")  End If  words = Split(s)  If IsVertical Then  words = Application.WorksheetFunction.Transpose(Split(s))  End If End Function  

а) Пример использования ввода многорядного диапазона в B2

 =words(A2:A4)  

udf

б) Пример вызова с помощью кода

 Option Explicit ' module head of code module   Sub ExampleCall  With Sheet1  Dim wds As Variant  wds = words(.Range("A2:A4"))  .Range("A10").Resize(UBound(wds), UBound(wds, 2)) = wds  End With End Sub  

Однако, если вы намерены отображать результаты горизонтально, просто введите следующий код (обратите внимание на изменение размера!):

 '...  wds = words(.Range("a2:a4"), False) ' False returns "flat" 1-dim array  .Range("A10").Resize(1, UBound(wds)) = wds