在VBA中查找数组中第一行的长行,而不是跟随行的零行

时间:2016-10-19 09:14:06

标签: arrays excel vba

我有一个填充零的数组和类似的数组:

... 00011000111100001100的 1 1111100111 ...

它始终以零开头,以1结尾。

我必须找到第一行开头的索引,它比下一行零更长。上面的粗体。

我已经使用第一个索引设置了一个,并使用最后一个零的索引设置了b。

k = 0
Do While array(k) = 0

    k = k + 1

Loop

 a = k

l = endOfArray
Do While array(l) = 1

    l = l - 1

Loop

 b = l

我怎么能继续?

4 个答案:

答案 0 :(得分:1)

你可以使用这个功能:

Option Explicit

Function GetOnes(inputStrng As String) As String
    Dim i As Long
    Dim zeros As Variant, ones As Variant

    zeros = Split(WorksheetFunction.Trim(Replace(inputStrng, "1", " ")))
    ones = Split(WorksheetFunction.Trim(Replace(inputStrng, "0", " ")))

    For i = 0 To UBound(ones)
        If Len(ones(i)) > Len(zeros(i)) Then
            GetOnes = ones(i)
            Exit For
        End If
    Next i
End Function

被利用如下:

Sub main()    
    MsgBox "the first 'ones' sequence longer then subsequent 'zero' sequence is:" & vbCrLf & vbCrLf & vbTab & GetOnes("0001100000111001111111")
End Sub

答案 1 :(得分:0)

未完全测试,但是这样的事情。抱歉,我已编码>之前,我稍后会改变。

Sub Testsing()

Dim strInput As String
Dim arrSplitInput() As String
Dim intLoop As Integer
Dim intZeroes As Integer
Dim intIndex As Integer

strInput = "0001100000111001111111"
arrSplitInput = Split(strInput, "0")

For intLoop = 0 To UBound(arrSplitInput)
    If arrSplitInput(intLoop) = "" Then
        intZeroes = intZeroes + 1
    Else
        If intIndex > 0 Then intZeroes = intZeroes + 1
        intIndex = intIndex + intZeroes
        If Len(arrSplitInput(intLoop)) > intZeroes Then
            Debug.Print Mid(strInput, intIndex - 1, Len(arrSplitInput(intLoop)))
            Stop
        Else
            intIndex = intIndex + Len(arrSplitInput(intLoop)) + 1
        End If

        intZeroes = 0

    End If

Next intLoop

End Sub

答案 2 :(得分:0)

对于一个简单的数组作业来说,答案是过度的,但只需要尝试一下OO VBA,看看如果需要扩展1s块所需的信息,你可以得到什么。

加入名为NumBlock的类模块(Alt-I-C)

Option Explicit

Private pLength As Long
Private pIndex As Long

Public Property Get Length() As Long
    Length = pLength
End Property

Public Property Let Length(val As Long)
    pLength = val
End Property

Public Property Get Index() As Long
    Index = pIndex
End Property

Public Property Let Index(val As Long)
    pIndex = val
End Property

常规模块:

Option Explicit

Public Function getIndexOfLongerOnes(arr As Variant) As NumBlock

  If InStr(1, TypeName(arr), "()", vbTextCompare) < 1 Then
        Err.Raise vbObjectError + 888, , "The argument was not an array!"
  End If
  Dim switched As Boolean
  Dim a As Long, z As Long
  Dim ones As NumBlock, zeroes As NumBlock

  a = LBound(arr)
  z = UBound(arr)
  switched = True
  Set ones = New NumBlock
  Set zeroes = New NumBlock

  Dim i As Long
  For i = a To z
        If i > a Then
              If arr(i) <> arr(i - 1) Then
                    switched = True
              Else
                    switched = False
              End If
        End If
        If arr(i) = 1 Then
              If switched Then
                    If ones.Length > zeroes.Length Then
                          Set getIndexOfLongerOnes = ones
                          Exit Function
                    End If
                    Set ones = New NumBlock
                    ones.Length = 1
                    ones.Index = i
              Else
                    ones.Length = ones.Length + 1
              End If
        Else
              If switched Then
                    Set zeroes = New NumBlock
                    zeroes.Length = 1
                    zeroes.Index = i
              Else
                    zeroes.Length = zeroes.Length + 1
              End If
        End If

  Next i

End Function

Public Sub test()

  On Error GoTo handler
  Dim testArr As Variant
  Dim block As NumBlock
  testArr = Array(0, 0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1)
  Set block = getIndexOfLongerOnes(testArr)

  MsgBox "Index: " & block.Index & vbNewLine & "Length: " & block.Length

  Exit Sub
handler:
  MsgBox Err.Description
End Sub

答案 3 :(得分:0)

一个更简单的数组作业:

Public Function getArrIndex(arr As Variant) As Long
  Dim switched As Boolean
  Dim a As Long, z As Long, currOnesIndex As Long, currZeroesIndex As Long, currOnesLength As Long, currZeroesLength As Long
  getArrIndex = -1 'default to -1 as not found qualifying set of ones
  a = LBound(arr)
  z = UBound(arr)
  switched = True

  Dim i As Long
  For i = a To z
        If i > a Then
              If arr(i) <> arr(i - 1) Then
                    switched = True
              Else
                    switched = False
              End If
        End If
        If arr(i) = 1 Then
              If switched Then
                    If currOnesLength > currZeroesLength Then
                          getArrIndex = currOnesIndex
                          Exit Function
                    End If
                    currOnesLength = 1
                    currOnesIndex = i
              Else
                    currOnesLength = currOnesLength + 1
              End If
        Else
              If switched Then
                    currZeroesLength = 1
                    currZeroesIndex = i
              Else
                    currZeroesLength = currZeroesLength + 1
              End If
        End If

  Next i
End Function