Удалить выбранные номера из списка управления запятыми в Excel?

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) меньше 6 минут после t(x-1), удалите t(x) и измените нумерацию 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 не проверяет, что строка имеет формат «число, число, число». Я изменил ProcessSingleCell, поэтому, если строка не в этом формате, она действительно изменит строку.

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

Answer 2

Очевидно, что есть много способов убрать эту кошку ... Мне нравится использовать коллекции для такого рода вещей:

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 разделяются запятыми и полагается на неявные преобразования str в int).Также, как написано, преобразует «2210, 2215, 2220, 2225, 2230, 2240» в «2210, 2040» - вам нужно будет настроить цикл, цикл ctr при удалении элемента, если это не то, что вам нужно.

Answer 3

Все еще не ясно, какие у вас точные требования, но это может помочь вам начать ....

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