最大VBA数
我有很多街区都有这样的名字：block-1 block-2 block-5 block-11 block-34。。。等我想从块名中获取数字（1,2,5,11,35…）并确定最大数+1
有人能帮我吗？ 假设块已存储在数组中，索引始终从第7个字符开始（长度无关）：
Blockslist = Array("Block-1", "Block-7", "Block-35", "Block-2", "Block-11")
以下代码将解决您的问题：
Dim BlockItem As Integer
Dim LastIndex As String: Dim CurrentIndex As String
LastIndex = Mid(Blockslist(0), 7) 'retain first index as reference
For BlockItem = 1 To UBound(Blockslist)
CurrentIndex = Mid(Blockslist(BlockItem), 7)
If CInt(CurrentIndex) > CInt(LastIndex) Then 'compare with current item's index
LastIndex = CurrentIndex 'and retain it if bigger
End If
Next BlockItem
LastIndex = LastIndex + 1 'increase maximum index
当做 Thx，这很有帮助。。。
如何将块名添加到数组中？ 上述功能将允许您根据名称模式对当前图形中定义的所有块进行排序：
Public Function SelectBlocksByPattern(ByVal NamePattern As String)
Dim theBlock As Variant: Dim BlocksList As Variant
Dim BlockName As String
BlocksList = Array()
For Each theBlock In ThisDrawing.Blocks 'parse blocks database
BlockName = theBlock.Name 'retain block's name
If Left(BlockName, Len(NamePattern)) = NamePattern Then 'compare with argument pattern
ReDim BlocksList(UBound(BlocksList) + 1) 'and retain it it match
BlocksList(UBound(BlocksList)) = BlockName
End If
Next theBlock
SelectBlocksByPattern = BlocksList 'return found blocks list
End Function
使用方法如下：
BlocksList = SelectBlocksByPattern("Block-")
当做 我没有什么问题，当图形文件中只有一个块（块-1）时，当有多个块（块-1，块-2，…）时，代码工作正常然后我有一条“运行时错误”消息。
Public Sub Lindex()
Dim BlockItem As Integer
Dim LastIndex As String: Dim CurrentIndex As String
BlocksList = SelectBlocksByPattern("Block-")
LastIndex = Mid(BlocksList(0), 7) 'retain first index as reference
For BlockItem = 1 To UBound(BlocksList)
CurrentIndex = Mid(BlocksList(BlockItem), 7)
If CInt(CurrentIndex) > CInt(LastIndex) Then 'compare with current item's index
LastIndex = CurrentIndex 'and retain it if bigger
End If
Next BlockItem
LastIndex = LastIndex + 1 'increase maximum index
MsgBox LastIndex
End Sub
Public Function SelectBlocksByPattern(ByVal NamePattern As String)
Dim theBlock As Variant: Dim BlocksList As Variant
Dim BlockName As String
BlocksList = Array()
For Each theBlock In ThisDrawing.Blocks 'parse blocks database
BlockName = theBlock.Name 'retain block's name
If Left(BlockName, Len(NamePattern)) = NamePattern Then 'compare with argument pattern
ReDim BlocksList(UBound(BlocksList) + 1) 'and retain it it match
BlocksList(UBound(BlocksList)) = BlockName
End If
Next theBlock
SelectBlocksByPattern = BlocksList 'return found blocks list
End Function 试试这个修改过的代码——错过了神奇的单词“Preserve”…
还为当前图形中没有块定义的情况添加了保护。
Public Sub Lindex()
Dim BlockItem As Integer
Dim LastIndex As String: Dim CurrentIndex As String
Dim BlocksList As Variant
BlocksList = SelectBlocksByPattern("Block-")
If UBound(BlocksList) = -1 Then Exit Sub 'exit if no block available
LastIndex = CInt(Mid(BlocksList(0), 7)) 'retain first index as reference
For BlockItem = 1 To UBound(BlocksList)
CurrentIndex = Mid(BlocksList(BlockItem), 7)
If CInt(CurrentIndex) > LastIndex Then 'compare with current item's index
LastIndex = CurrentIndex 'and retain it if bigger
End If
Next BlockItem
LastIndex = LastIndex + 1 'increase maximum index
MsgBox LastIndex
End Sub
Public Function SelectBlocksByPattern(ByVal NamePattern As String)
Dim theBlock As Variant: Dim BlocksList As Variant
Dim BlockName As String
BlocksList = Array()
For Each theBlock In ThisDrawing.Blocks 'parse blocks database
BlockName = theBlock.Name 'retain block's name
If Left(BlockName, Len(NamePattern)) = NamePattern Then 'compare with argument pattern
ReDim Preserve BlocksList(UBound(BlocksList) + 1) 'and retain it it match
BlocksList(UBound(BlocksList)) = BlockName
End If
Next theBlock
SelectBlocksByPattern = BlocksList 'return found blocks list
End Function
当做 Thx，非常。。。 不客气！
页:
[1]