Цикл по списку слов не может смещать данные для коллекции

Question

Немного глупый вопрос, вероятно, легкий ответ!

Я пытаюсь перебрать данные, я делю их через разделитель, а затем хочу сместить каждую разделенную часть в строку и перейти к следующей строке / данным,

Вот мой код:

Dim undelimitedstring As String

    undelimitedstring = AlphaNumericOnly(rng.Value)

    WordsList = Split(undelimitedstring, "Q")

    result = ""
    Count = UBound(WordsList)

    For i = 1 To Count

        Dim ios As Integer
        ios = 0
        Worksheets("Calendar").Range("H" & rng.Row).Activate
        MsgBox (WordsList(i))

        For Each element In WordsList
            Dim n As Integer
            Dim o As Integer
            n = 0
            o = 1
            ActiveCell.Offset(0, n).Value = WordsList(o)
        Next element

    ios = ios + 1
    Next i

Если кто-то может помочь, это будет потрясающе!

Answer 1

Немного догадываюсь, что вы подразумеваете под

Я разделил его через разделитель, а затем хочу сместить каждую часть разделения на строка

Этот код будет принимать строку типа 123 456 Q 654 321 987 Q 789 012 и разбивать ее на три строки:

• 123 456
• 654 321 987
• 789 012

Для использования:
Если A1 содержит 123 456 Q 654 321 987 Q 789 012 , выделите C1:C3 и введите =SplitString(A1) в качестве формулы массива.

Public Function SplitString(Target As Range, Optional Delim As String = "Q") As Variant

    SplitString = Application.WorksheetFunction.Transpose(Split(Target, Delim))

End Function

---

Если вы хотите, чтобы это была процедура, а не функция, используйте:

Sub Test()

    SplitString_2 Sheet1.Range("A1"), Sheet1.Range("D1")

End Sub

Public Sub SplitString_2(Target As Range, Destination As Range, Optional Delim As String = "Q")

    Dim vSplit As Variant
    Dim lElements As Long

    vSplit = Split(Target, Delim)
    lElements = UBound(vSplit) + 1 'Assumes LBound = 0

    Destination.Resize(lElements) = Application.WorksheetFunction.Transpose(vSplit)

End Sub

Answer 2

Я полагаю, что следующее будет делать то, что вы ожидаете, оно получит все значения в WordsList и введет каждое значение в новую строку в столбце H:

Dim undelimitedstring As String

undelimitedstring = AlphaNumericOnly(Rng.Value)

WordsList = Split(undelimitedstring, "Q")

result = ""

For i = 1 To UBound(WordsList)
    NextFreeRow= Worksheets("Calendar").Cells(Worksheets("Calendar").Rows.Count, "H").End(xlUp).Row + 1
    Worksheets("Calendar").Range("H" & NextFreeRow).Value = WordsList(i)
Next i

ОБНОВЛЕНИЕ:

Измененный код ниже добавит два значения из WordList к строке в соседних ячейках, а затем перейдет к следующей строке и добавит следующие два значения и т. Д .:

Dim undelimitedstring As String

undelimitedstring = AlphaNumericOnly(Rng.Value)

WordsList = Split(undelimitedstring, "Q")

result = ""
NextFreeRow = Worksheets("Calendar").Cells(Worksheets("Calendar").Rows.Count, "H").End(xlUp).Row + 1
Counter = 0
For i = 1 To UBound(WordsList)
    Counter = Counter + 1
    Worksheets("Calendar").Range("H" & NextFreeRow).Value = WordsList(i)
    If Counter = 2 Then
    Worksheets("Calendar").Range("I" & NextFreeRow).Value = WordsList(i)
        NextFreeRow = NextFreeRow + 1
        Counter = 0
    End If
Next i