Разбирая запятую строку серийных номеров

Question

Мне бы хотелось получить руководство / помощь по кодированию VBA-кодированного решения для моего сценария, подробности приведены ниже. Мне очень комфортно с VBA-кодированием - я действительно ищу совет о том, как подойти к проблеме, а не какое-либо конкретное решение.

В моем отделе очень завидная задача ежедневного изготовления этикеток. Мы получаем электронную таблицу от Production, в которой есть ячейка / ячейки с серийными номерами для печати (примеры ниже). Числа часто не являются смежными, но основной (созданный человеком) «формат» одинаков (дефисы для диапазонов, запятые для отдельных чисел). Серийные номера в приведенном ниже примере состоят из 6 цифр, но часто имеют разную длину, что усложняет задачу. Я ищу отзывы о том, как в конечном итоге разобрать cell.text в полный список серийных номеров, которые в конечном итоге могут быть использованы в качестве источника для программного обеспечения нашего принтера этикеток.

Опять же, я думаю, что у меня есть возможность фактически закодировать это; Я спрашиваю, как подходить к синтаксическому анализу cell.value (s), определять пробелы, запятые и дефисы по мере необходимости и получать список серийных номеров в любом пригодном для использования формате. Я могу разделять запятыми и кодировать диапазон до и после дефиса. Как мне подойти к 6-значному формату, а также к переходу на первые три символа (364-365, может быть много).

ПРИМЕР РАСПРЕДЕЛИТЕЛЬНОЙ КЛЕТКИ. ЗНАЧЕНИЕ: " 364701-703, 705, 706, 708-710, 365100-104, 121 " - запрос на 14 меток:

ОЖИДАЕМЫЙ РАСПРОСТРАНЕННЫЙ РЕЗУЛЬТАТ: 364701, 364702, 36703, 364705, 364706, 364708, 364709, 364710, 365100, 365101, 365102, 365013, 350104, 365121

Answer 1

попробуйте это:

Function trlMyString(myString As String) As String
    On Error GoTo trlMyStringError

    Dim i As Integer
    Dim j As Integer

    Dim helpArray() As String
    Dim strg As String

    Dim label1 As String
    Dim label2 As String

    strg = ""

    helpArray() = Split(myString, ", ")
    For i = LBound(helpArray) To UBound(helpArray)
        If Len(helpArray(i)) > 3 And InStr(1, helpArray(i), "-") <> 4 Then
            label1 = Left$(helpArray(i), 3)
            helpArray(i) = Right$(helpArray(i), Len(helpArray(i)) - 3)
        End If
        If InStr(1, helpArray(i), "-") > 0 Then
            For j = CInt(Left$(helpArray(i), 3)) To CInt(Right$(helpArray(i), 3))
                'Debug.Print CInt(Left$(helpArray(i), 3)), CInt(Right$(helpArray(i), 3))
                label2 = Trim$(Str$(j))
                strg = strg & label1 & label2 & ", "
            Next j
        Else
            label2 = helpArray(i)
            strg = strg & label1 & label2 & ", "
        End If
    Next i

    'Debug.Print strg

    trlMyStringExit:
    trlMyString = strg
    Exit Function
    trlMyStringError:
    Resume trlMyStringExit
End Function

Answer 2

Это просто вопрос того, как вы следите за вещами.

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

Option Explicit
Sub labelMaker()
    Const sRequest As String = "364701-703, 705, 706, 708-710,364800, 365100-104, 121"
    Dim V, W, X
    Dim lFirstThree As Long, I As Long, J As Long
    'Dim D As Dictionary 'early binding
    Dim D As Object 'late binding

'Set D = New Dictionary 'early binding
Set D = CreateObject("Scripting.Dictionary") 'late binding
V = Split(Replace(sRequest, " ", ""), ",")
For Each W In V
    X = Split(W, "-")
    If Len(X(0)) = 6 Then lFirstThree = Left(X(0), 3) 'we start a new series
        For I = Right(X(LBound(X)), 3) To Right(X(UBound(X)), 3)
            D.Add lFirstThree & I, lFirstThree & I
        Next I
Next W

'write the results to the worksheet
V = WorksheetFunction.Transpose(D.Keys)
With Cells(1, 1).Resize(D.Count) 'will be on active sheet
    .EntireColumn.Clear
    .Value = V
End With                        
End Sub

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

Answer 3

Вы можете закодировать его, как хотите, и опубликовать его на https://codereview.stackexchange.com/, и тогда вы сможете увидеть, как к нему могут подойти другие люди.

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

Public Sub GenerateSerialNumbers(ByVal sNumbers As String)

    Dim vaComma As Variant, vaHyph As Variant
    Dim i As Long, j As Long
    Dim lPrefix As Long, lStart As Long, lEnd As Long
    Dim sInput As String
    Dim dc As Scripting.Dictionary

    Set dc = New Scripting.Dictionary
    vaComma = Split(sNumbers, ",")

    For i = LBound(vaComma) To UBound(vaComma)
        sInput = Trim$(vaComma(i))

        If InStr(1, sInput, "-") > 0 Then
            vaHyph = Split(sInput, "-")

            'If you get a full one, keep the first three
            If Len(vaHyph(0)) = 6 Then lPrefix = Val(Left$(sInput, 3)) * 1000

            'Add the prefix if needed
            lStart = Val(vaHyph(0))
            If lStart < 1000 Then lStart = lPrefix + lStart
            lEnd = Val(vaHyph(1))
            If lEnd < 1000 Then lEnd = lPrefix + lEnd
        Else
            If Len(sInput) = 6 Then lPrefix = Val(Left$(sInput, 3)) * 1000
            lStart = Val(sInput)
            If lStart < 1000 Then lStart = lPrefix + lStart
            lEnd = lStart
        End If

        'Generate the list
        For j = lStart To lEnd
            dc.Add j, j
        Next j

    Next i

    Sheet1.Range("a1").Resize(dc.Count, 1).Value = Application.Transpose(dc.Items)

End Sub