Как разделить диапазон значений запятыми и "и" перед последним значением?

Question

Я пытаюсь создать код, который позволит пользователю вводить список элементов от A1 вниз и отображать их все в виде списка в предложении с правильными запятыми и позициями 'и'.

Например, для

 A1. Shoe
 A2. Tree
 A3. Box
 A4. Toy

я хочу, чтобы в окне сообщения отображалось: «Вы вошли в башмак, дерево, коробку и игрушку».

Я совершенно растерялся, как его получитьраспознавать, где ставить 'и'.

Любая помощь приветствуется.

Я пытался завершить это с некоторыми утверждениями For, но я застрял при определении, где или как поставить'и' в списке, учитывая, что в списке может быть разное количество элементов.

Спасибо

Answer 1

Столбец к предложению

Особенности

• По крайней мере, две ячейки данных в диапазоне, иначе "" возвращается.
• Только первый столбец диапазона являетсяобработано (Resize).

Использование в Excel

Код

Function CCE(Range As Range) As String

    Application.Volatile

    Const strFirst = "You have entered "  ' First String
    Const strDEL = ", "                   ' Delimiter
    Const strDELLast = " and "            ' Last Delimiter
    Const strLast = "."                   ' Last String

    Dim vnt1 As Variant   ' Source Array
    Dim vnt0 As Variant   ' Zero Array
    Dim i As Long         ' Arrays Row Counter

    ' Copy Source Range's first column to 2D 1-based 1-column Source Array.
    vnt1 = Range.Resize(, 1)
    ' Note: Join can be used only on a 0-based 1D array.
    ' Resize Zero Array to hold all data from Source Array.
    ReDim vnt0(UBound(vnt1) - 1)

    ' Copy data from Source Array to Zero Array.
    For i = 1 To UBound(vnt1)
        If vnt1(i, 1) = "" Then Exit For
        vnt0(i - 1) = vnt1(i, 1)
    Next

    ' If no "" was found, "i" has to be greater than 3 ensuring that
    ' Source Range contains at least 2 cells.
    If i < 3 Then Exit Function
    ReDim Preserve vnt0(i - 2)

    ' Join data from Zero Array to CCE.
    CCE = Join(vnt0, strDEL)
    ' Replace last occurence of strDEL with strDELLast.
    CCE = WorksheetFunction.Replace( _
            CCE, InStrRev(CCE, strDEL), Len(strDEL), strDELLast)
    ' Add First and Last Strings.
    CCE = strFirst & CCE & strLast

End Function

Answer 2

Массив с помощью Join с простым транспонированием

• Ваш пост предполагает гибкий диапазон в столбце A:A, поэтому первый шаг [1] получает последнюю строкуномер и определяет диапазон данных.
• На шаге [2] назначенный диапазон данных присваивается массиву , который должен быть вариантом.Функция Application.Transpose изменяет исходные данные столбца на «плоский» массив всего за одну строку кода и уменьшает размер по умолчанию для 2-dim до простого массива с 1-dim.Кроме того, последний элемент просто обогащается путем вставки "и".Это позволяет избежать сложного действия разделения и поиска.
• Шаг [3] позволяет объединить любой 1-мерный массив с помощью функции Join и вставитьлюбой пользовательский разделитель (например, двоеточие ",").Наконец, перед двоеточием «и» удаляется начальная двоеточие, заменяя только «и» на «и».
• Step [4] отображает окно с сообщением.

Пример кода

Option Explicit                               ' declaration head of your code module

Sub displayMsg()
' [0] declare constants and variables
  Const LNK$ = " and ", COLON$ = ","              ' define linking constants "and" plus COLON
  Dim v  As Variant, msg$, lastRow&               ' provide for variant datafield array and message string
  Dim ws As Worksheet, rng As Range               ' declare worksheet object     *)
  Set ws = ThisWorkbook.Worksheets("MySheetName") ' << change to your sheet name *)
' [1] define flexible range object in column A:A via last row number
  lastRow = ws.Range("A" & ws.Rows.count).End(xlUp).Row
  Set rng = ws.Range("A1:A" & lastRow)            ' e.g. A1:A4, if n = 4
' [2] get 2-dim column data to "flat" 1-dim array
  v = Application.Transpose(rng)                  ' read into array and make it "flat"
  v(UBound(v)) = LNK & v(UBound(v))               ' insert " and " into last array element
' [3] concatenate elements and delete superfluous last colon
  msg = Replace(Join(v, COLON), COLON & LNK, LNK) ' get wanted message string
' [4] display message
  MsgBox "You have entered " & msg & ".", vbInformation, UBound(v) & " elements"
End Sub

Альтернативная ссылка

*) Вместо ссылки на рабочий лист ws, например, ThisWorkBook.Worksheets("MySheetName"), вы можете просто использовать CodeName на рабочем листе, как указано в VB Editor (без объявления ws и установки его в память), просто кодируйте следующим образом:

' [1] define flexible range object in column A:A via last row number
  lastRow = Sheet1.Range("A" & Sheet1.Rows.count).End(xlUp).Row  
  Set rng = Sheet1.Range("A1:A" & lastRow)

Наслаждайтесь : -)

Answer 3

Вы можете попробовать этот код:

Sub Sample()

    ' Define object variables
    Dim listRange As Range
    Dim cellValue As Range

    ' Define other variables
    Dim itemsQuantity As Integer
    Dim stringResult As String
    Dim separator As String
    Dim counter As Integer

    ' Define the range where the options are located
    Set listRange = Range("A1:A4")

    itemsQuantity = listRange.Cells.Count

    counter = 1

    For Each cellValue In listRange

        ' Select the case for inner items, penultimate and last item
        Select Case counter
        Case Is < itemsQuantity
            separator = ", "
        Case Is = itemsQuantity - 1
            separator = " And "
        Case Else
            separator = vbNullString
        End Select

        stringResult = stringResult & cellValue.Value & separator

        counter = counter + 1

    Next cellValue

    ' Assamble the last sentence
    stringResult = "You have entered " & stringResult & "."

    MsgBox stringResult

End Sub

Настроить:
'Определить диапазон, в котором расположены опции

Приветствия!