我有一个填充零的数组和类似的数组:
... 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
我怎么能继续?
答案 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