input框的文本到列固定宽度 – Excel崩溃

我正在尝试使用input框来要求用户input数据中正在使用的帐号的长度（可能会有所不同），然后根据用户input的固定宽度分割列。 在我的研究中，我只能find插入两个len公式在单独的列，然后删除原来的。 如果可能，我正试图避免这种情况。

这是我目前的代码：

  Dim Message, Title, Default, MyValue Message = "Input the character length of the account numbers." Title = "Account Number Length" Default = "4" MyValue = InputBox(Message, Title, Default) 'Split Account numbers Columns("B:B").Select Selection.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _ OtherChar:=":", FieldInfo:=Array(Array(0, 1), Array(MyValue, 1)), _ TrailingMinusNumbers:=True 

当我尝试使用MyValue作为FieldInfo:=Array(Array(0, 1), Array(MyValue, 1)) excel崩溃。 有没有一种方法来定义或input它，以便将input值作为值插入到Array(MyValue, 1) ，而不会导致Excel崩溃？

例如，如果账号长度是4，那么返回值应该是Array（4，1）。

Answer 1

 Sub test() Dim Message, Title, Default, MyValue Dim rngRaw As Range Message = "Input the character length of the account numbers." Title = "Account Number Length" Default = "4" '/ Pass as numeric MyValue = Val(InputBox(Message, Title, Default)) 'Split Account numbers 'Columns("B:B").Select 'Instead of full column try with data range. Avoids crash. Set rngRaw = Sheet1.UsedRange.Columns(2) '/ Change as per your actual data. rngRaw.TextToColumns Destination:=rngRaw.cells(1,1), DataType:=xlFixedWidth, _ OtherChar:=":", FieldInfo:=Array(Array(0, 1), Array(MyValue, 1)), _ TrailingMinusNumbers:=True End Sub 

'/根据用户在评论中的查询更新'/ /另一个版本与do循环。 我不推荐这个

 Sub test() Dim Message, Title, Default, MyValue As String Dim rngRaw As Range Dim lDelLen As Long Message = "Input the character length of the account numbers." Title = "Account Number Length" Default = "4" '/ Pass as numeric MyValue = "Foo" Do MyValue = InputBox(Message, Title, Default) 'If a user presses cancel then MyValue ' is a vbNullString and we should allow the ' user to abort the entire sub If MyValue = vbNullString Then Exit Sub If IsNumeric(MyValue) Then Exit Do Loop lDelLen = Val(MyValue) 'Split Account numbers 'Columns("B:B").Select 'Instead of full column try with data range. Avoids crash. Set rngRaw = Sheet1.UsedRange.Columns(2) '/ Change as per your actual data. rngRaw.TextToColumns Destination:=rngRaw.Cells(1, 1), DataType:=xlFixedWidth, _ OtherChar:=":", FieldInfo:=Array(Array(0, 1), Array(lDelLen, 1)), _ TrailingMinusNumbers:=True End Sub