如何在逗号分隔值的范围内，最后一个值之前加上“和”？

Question

我正在尝试编写一个代码，允许用户从A1向下输入项目列表，并将它们全部显示为带有正确逗号和“和”位置的句子列表。

例如下面的

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

我想要一个消息框显示“您已经输入了鞋，树，盒子和玩具”。

我完全迷失了如何识别“ and”的位置。

感谢您的帮助。

我试图用一些For语句来完成此操作，但是考虑到列表中可能存在不同数量的项目，我在确定“ and”在列表中的位置或方式时陷入困境。

谢谢

Answer 1

您可以尝试以下代码：

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

自定义：
'定义选项所在部分的范围

干杯！

Answer 2

句子专栏

功能

• 返回Range中至少两个数据单元，否则返回“”。
• 仅处理范围的第一列（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 3

通过Join的数组解决方案，具有简单的转置

• 您的帖子在A:A列中假设一个灵活的范围，因此第一步[1]获取最后一行的行号并定义数据范围。
• 在步骤[2]中，您将找到的数据范围分配给必须是变体的数组。 Application.Transpose函数仅将一条代码行中的原始列数据更改为“平面”数组，并将其2维默认维减少为简单的1维数组。此外，最后一个元素只是通过插入“和”来丰富。这样可以避免复杂的拆分和查找操作。
• 步骤[3]允许串连通过在 Join 功能的任何1维数组和插入任何用户定义的分隔符（例如，冒号“ ，”）。最后，通过仅用“和”替换“和”来删除“和”之前的前导冒号。
• 步骤[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")，则可以简单地使用该工作表的代号而不是如在VB编辑器中列出（不宣ws，以及将其设置到存储器）刚刚编码，如下所示：< / p>

' [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)

享受它：-）