Функция VBA с массивом в качестве возвращаемого значения - PullRequest
Новая
       17

Функция VBA с массивом в качестве возвращаемого значения

1 голос
/ 13 января 2012

У меня есть следующий код: 

Function TruncateString(str, n)
    ' Returns an array with strings no more than n char long, truncated at spaces
    Dim truncatedArr() As String
    If str <> "" Then
            str = remove_spaces_left(str)
        For i = 0 To (CLng(Len(str) / n))
            Index = InStrRev(Left(str, n), " ")
            ReDim Preserve truncatedArr(i)
            truncatedArr(i) = Left(str, Index)
            If Right(truncatedArr(i), 1) = " " Then truncatedArr(i) = Left(truncatedArr(i), Len(truncatedArr(i)) - 1)
            str = Right(str, Len(str) - Index)
        Next i
    End If
    TruncateString = truncatedArr
End Function

Мой вопрос: какое значение возвращает функция, когда str пусто?У меня возникает проблема совместимости типов, когда я
arr = TruncateString (text,15)

arr определяется следующим образом:
dim arr() as string

, пожалуйста, дайте мне знать, если дляответ.Спасибо

Ответы [ 2 ]

5 голосов
/ 13 января 2012

В вашем коде несколько проблем:

  • вы должны использовать Option Explicit в начале модуля, чтобы вы были вынуждены объявить все ваши переменные (включая i и Index, которые должны быть переименованы, потому что это вызывает конфликт с собственностью)
  • ваш код не работает, если в выбранном диапазоне символов нет пробела (возвращает пустую строку)

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

4 голосов
/ 14 января 2012

Я подумал, что это была интересная задача кодирования, ниже приведены две мои попытки написать более эффективную функцию, которая "подрезает" большую строку на

  • Пробел [CHR (32)]
  • затем на фиксированную длину

  • затем с любой остаточной длиной, перенесенной на

    1. Мой предпочтительный метод использует rexexp, чтобы немедленно разбить строку
    2. Второй метод запускает 3 манипуляции со строками, и мне кажется, что это уродливее и сложнее
      • использует Split для разделения строки на более мелкие фрагменты текста, используя пробел в качестве разделителя
      • проходит через каждый элемент этого массива и разбивает его на блоки фиксированной длины, используя Mid$
      • проверяет, остались ли какие-либо строки, меньшие, чем требуемые фрагменты фиксированной длины (с проверкой Mod), если да, то добавляет эти частичные строки к окончательному результату

Обе функции возвращают массив путем разбиения окончательного текста, который я затем возвратил в виде одной строки, используя Join в моей основной подпрограмме.

Код 

Sub Test()
    Dim strIn As String
    Dim lngChks As Long
    strIn = Application.Rept("The quick fox jumped over the lazy dog", 2)
    lngChks = 2
    MsgBox Join(TruncateRegex(strIn, lngChks), vbNewLine)
    MsgBox Join(TruncateMid(strIn, lngChks), vbNewLine)
End Sub

1 - регулярное выражение 

Function TruncateRegex(ByVal strIn, ByVal lngChks)
    Dim objRegex As Object
    Dim objRegMC As Object
    Dim objRegM As Object
    Dim strOut As String
    Dim lngCnt As Long
    Set objRegex = CreateObject("vbscript.regexp")
    With objRegex
        .Pattern = "[^\s]{1," & lngChks - 1 & "}(\s+|$)|[^\s]{" & lngChks & "}"
        .Global = True
        'test to avoid nulls
        If .Test(strIn) Then
            Set objRegMC = .Execute(strIn)
            For Each objRegM In objRegMC
                'concatenate long string with (short string & short string)
                strOut = strOut & (objRegM & vbNewLine)
            Next
        End If
    End With
    TruncateRegex = Split(strOut, vbNewLine)
End Function

2 струна 

Function TruncateMid(ByVal strIn, ByVal lngChks)
    Dim arrVar
    Dim strOut As String
    Dim lngCnt As Long
    Dim lngCnt2 As Long
    'use spaces to delimit string array
    arrVar = Split(strIn, Chr(32))
    For lngCnt = LBound(arrVar) To UBound(arrVar)
        If Len(arrVar(lngCnt)) > 0 Then
            lngCnt2 = 0
            For lngCnt2 = 1 To Int(Len(arrVar(lngCnt)) / lngChks)
                strOut = strOut & (Mid$(arrVar(lngCnt), (lngCnt2 - 1) * lngChks + 1, lngChks) & vbNewLine)
            Next
            'add remaining data at end of string < lngchks
             If Len(arrVar(lngCnt)) Mod lngChks <> 0 Then strOut = strOut & (Mid$(arrVar(lngCnt), (lngCnt2 - 1) * lngChks + 1, Len(arrVar(lngCnt)) Mod lngChks) & vbNewLine)
        End If
    Next
    TruncateMid = Split(strOut, vbNewLine)
End Function
...