Question

即使使用VBA，这可能有点棘手......

我根据5分钟间隔的开始时间在单元格中使用逗号分隔列表，但我需要删除仅相隔5的时间。

数字是文字，而不是时间。例如，一个列表将是2210,2215,2225,2230,2240（开始时间）。

在这种情况下，应该删除2215和2230，但在其他情况下（结束时间）我还需要删除相反的数字（即2210和2225）。

有人帮助我制定了我的规格：

单元格包含时间：t(1), t(2), t(3), ... t(n)。从时间t(1)开始，检查列表中的每个值。如果t(x)在t(x-1)删除t(x)后不到6分钟，并将t(x+1)重新编号为t(n)。

输入：

2210, 2215, 2225, 2230, 2240

输出：

column1: 2210
column2: 2240

Answer 1

这就是我认为你需要的。

Option Explicit
Sub DeleteSelectedTimes()

  Dim RowCrnt As Long

  RowCrnt = 2

  Do While Cells(RowCrnt, 1).Value <> ""
    Cells(RowCrnt, 1).Value = ProcessSingleCell(Cells(RowCrnt, 1).Value, 1)
    Cells(RowCrnt, 2).Value = ProcessSingleCell(Cells(RowCrnt, 2).Value, -1)
    RowCrnt = RowCrnt + 1
  Loop

End Sub
Function ProcessSingleCell(ByVal CellValue As String, ByVal StepFactor As Long) As String

  Dim CellList() As String
  Dim CellListCrntStg As String
  Dim CellListCrntNum As Long
  Dim InxCrnt As Long
  Dim InxEnd As Long
  Dim InxStart As Long
  Dim TimeCrnt As Long    ' Time in minutes
  Dim TimeLast As Long    ' Time in minutes

  CellList = Split(CellValue, ",")

  If StepFactor = 1 Then
    InxStart = LBound(CellList)
    InxEnd = UBound(CellList)
  Else
    InxStart = UBound(CellList)
    InxEnd = LBound(CellList)
  End If

  CellListCrntStg = Trim(CellList(InxStart))
  If (Not IsNumeric(CellListCrntStg)) Or InStr(CellListCrntStg, ".") <> 0 Then
    ' Either this sub-value is not numeric or if contains a decimal point
    ' Either way it cannot be a time.
    ProcessSingleCell = CellValue
    Exit Function
  End If
  CellListCrntNum = Val(CellListCrntStg)
  If CellListCrntNum < 0 Or CellListCrntNum > 2359 Then
    ' This value is not a time formatted as hhmm
    ProcessSingleCell = CellValue
    Exit Function
  End If
  TimeLast = 60 * (CellListCrntNum \ 100) + (CellListCrntNum Mod 100)

  For InxCrnt = InxStart + StepFactor To InxEnd Step StepFactor
    CellListCrntStg = Trim(CellList(InxCrnt))
    If (Not IsNumeric(CellListCrntStg)) Or InStr(CellListCrntStg, ".") <> 0 Then
      ' Either this sub-value is not numeric or if contains a decimal point
      ' Either way it cannot be a time.
      ProcessSingleCell = CellValue
      Exit Function
    End If
    CellListCrntNum = Val(CellListCrntStg)
    If CellListCrntNum < 0 Or CellListCrntNum > 2359 Then
      ' This value is not a time formatted as hhmm
      ProcessSingleCell = CellValue
      Exit Function
    End If
    TimeCrnt = 60 * (CellListCrntNum \ 100) + (CellListCrntNum Mod 100)
    If Abs(TimeCrnt - TimeLast) < 6 Then
      ' Delete unwanted time from list
      CellList(InxCrnt) = ""
    Else
      ' Current time becomes Last time for next loop
      TimeLast = TimeCrnt
    End If
  Next

  CellValue = Join(CellList, ",")

  If Left(CellValue, 1) = "," Then
    CellValue = Mid(CellValue, 2)
    CellValue = Trim(CellValue)
  End If

  Do While InStr(CellValue, ",,") <> 0
    CellValue = Replace(CellValue, ",,", ",")
  Loop

  ProcessSingleCell = CellValue

End Function

<强>解释

很抱歉第一个版本缺少说明。我认为这个问题更多的是关于操纵数据的技术，而不是关于VBA。

DeleteSelectedTimes在有效工作表上运行。如果您需要，可以很容易地更改为在特定工作表或一系列工作表上工作。

DeleteSelectedTimes忽略我假设包含列标题的第一行。当然，我的测试工作表在第1行中有标题。然后它处理每一行的A和B列，直到它到达一个空列A的行。

ProcessSingleCell有两个参数：字符串和方向。 DeleteSelectedTimes使用方向，因此A列中的值从左到右处理，而B列中的值从右到左处理。

我认为#Value错误是因为ProcessSingleCell没有检查字符串是否为“number，number，number”格式。我已经更改了ProcessSingleCell，所以如果字符串不是这种格式，它确实会更改字符串。

我不知道你做了什么或不知道什么，所以在必要时回来提出更多问题。

Answer 2

仍然不清楚您的确切要求，但这可能有助于您入门....

Sub Tester()

    Dim arr
    Dim out As String, x As Integer, c As Range
    Dim n1 As Long, n2 As Long

    For Each c In ActiveSheet.Range("A1:A10")
        If InStr(c.Value, ",") > 0 Then

            arr = Split(c.Value, ",")
            x = LBound(arr)
            out = ""
            Do
                n1 = CLng(Trim(arr(x)))
                n2 = CLng(Trim(arr(x + 1)))

                'here's where your requirements get unclear...
                out = out & IIf(Len(out) > 0, ", ", "")
                If n2 - n1 <= 5 Then
                    out = out & n1 'skip second number
                    x = x + 2
                Else
                    out = out & n1 & ", " & n2 'both
                    x = x + 1
                End If

            Loop While x <= UBound(arr) - 1
            'pick up any last number
            If x = UBound(arr) Then
                out = out & IIf(Len(out) > 0, ", ", "") & arr(x)
            End If

            c.Offset(0, 1).Value = out
        End If
    Next c
End Sub

Answer 3

显然有很多方法可以让这只猫受到伤害......我喜欢使用集合来做这类事情：

Private Sub PareDownList()
  Dim sList As String:  sList = ActiveCell        ' take list from active cell
  Dim vList As Variant: vList = Split(sList, ",") ' convert to variant array
  ' load from var array into collection
  Dim cList As New Collection
  Dim i As Long
  For i = 0 To UBound(vList): cList.Add (Trim(vList(i))): Next
  ' loop over collection removing unwanted entries
  ' (in reverse order, since we're removing items)
  For i = cList.Count To 2 Step -1
      If cList(i) - cList(i - 1) = 5 Then cList.Remove (i)
  Next i
  ' loop to put remaining items back into a string fld
  sList = cList(1)
  For i = 2 To cList.Count
      sList = sList + "," + cList(i)
  Next i
  ' write the new string to the cell under the activecell
  ActiveCell.Offset(1) = "'" + sList ' lead quote to ensure output cell = str type
End Sub

' If activecell contains:  "2210, 2215, 2225, 2230, 2240"
' the cell below will get: "2210,2225,2240"

注意：此示例代码应该通过一些额外的验证来增强。检查（例如，如所写的假设所有良好的int值由逗号＆amp;依赖于隐式str到int转换）。另外，如果写入将“2210,2215,2220,2225,2230,2240”转换为“2210,2040” - 你需要调整循环，在删除项目时循环ctr，如果那不是你想要的那样。

从Excel中的逗号分隔列表管理中删除选定的数字？

输入：

输出：

3 个答案: