在VBA中查找数组中第一个较长的行

我有一个数组填充零和像这样的：

… 00011000111100001100 1 1111100111 …

它总是以零开始，以一个结尾。

我必须find第一行的开始索引，比下一行的长。 上面的大胆的一个。

我已经设置了第一个索引，并用最后一个零的索引来设置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 

我要如何继续？

Answer 1

你可以使用这个function：

 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 

Answer 2

没有完全testing，但这样的事情。 对不起，我已经编码>以前，我会稍后改变。

 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 

Answer 3

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

放入一个名为NumBlock的类模块 （Alt-IC）

 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 

Answer 4

一个更简单的数组作业：

 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