VBA多次拆分相同的字符串

时间:2012-04-23 19:21:40

标签: string excel-vba split vba excel

我一直在网上搜索,我似乎无法弄清楚我的问题。任何帮助将非常感激。我的代码如下:

Private Sub removebutton_Click()
Dim iRow As Long
Dim ws As Worksheet
Dim removebox As String
Set ws = Worksheets("Sheet2")
removebox = InputBox("Please Scan the Barcode to be added", "Add Coin", "Scan Barcode Here")
'Find the next blank row'
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

'Promt User To Actually input data if they have not entered anything'
If Trim(Me.removebox.Value) = "" Then
Me.removebox.SetFocus
MsgBox "Please enter barcode"
Exit Sub
End If

'For 20 digit barcodes split into 4 parts and record the data in the next blank row'
If Len(removebox) = 20 Then
Dim s1 As String
s1 = removebox.Substring(1, 6)
Dim s2 As String
s2 = removebox.Substring(7, 8)
Dim s3 As String
s3 = removebox.Substring(9)
Dim s4 As String
s4 = removebox.Substring(10, 20)

ws.Cells(iRow, 1).Value = Me.s1.Value
ws.Cells(iRow, 2).Value = Me.s2.Value
ws.Cells(iRow, 3).Value = Me.s3.Value
ws.Cells(iRow, 4).Value = Me.s4.Value

'For 18 Digit barcodes spilt into 3 parts and record the data in the next blank row'
ElseIf (removebox) = 18 Then
Dim s5 As String
s5 = removebox.Substring(1, 6)
Dim s6 As String
s6 = removebox.Substring(7, 8)
Dim s7 As String
s7 = removebox.Substring(9, 18)

ws.Cells(iRow, 1).Value = Me.s5.Value
ws.Cells(iRow, 2).Value = Me.s6.Value
ws.Cells(iRow, 3).Value = Me.s7.Value

'If not 20 or 18 digit then it is 16, split into 3 parts and record the data in the next blank row'
Else
Dim s8 As String
s8 = removebox.Substring(1, 6)
Dim s9 As String
s9 = removebox.Substring(7, 8)
Dim s10 As String
s10 = removebox.Substring(9, 16)

ws.Cells(iRow, 1).Value = Me.s8.Value
ws.Cells(iRow, 2).Value = Me.s9.Value
ws.Cells(iRow, 3).Value = Me.s10.Value
End If

End Sub

所以我搞砸了整个代码应该是删除一个项目,而是添加了一个我意识到的项目。我的问题是s1 = removebox.Substring(1, 6)突出显示removebox变量并告诉我Compiler Error: Invalid Qualifier。如果有人能给我一个可能的解决方案,我知道我做错了但是当你扫描一个条形码时它会以20,18或16位整数形式出现,但我需要分别保存这些零件以便创建一个简单的数据库的查找功能。

提前感谢您提供任何帮助或建议。

1 个答案:

答案 0 :(得分:0)

餐饮主管打败了我。但是我会粘贴代码,因为我已经开始工作了。

  
    
      

条形码以20,18或16位整数形式出现

    
  

注意:基于以上所述,我并没有把它分成4个相等的部分。我只是转换了您现有的代码。

Option Explicit

Private Sub removebutton_Click()
    Dim iRow As Long
    Dim ws As Worksheet
    Dim removebox As String

    Set ws = Worksheets("Sheet2")

    removebox = InputBox("Please Scan the Barcode to be added", _
    "Add Coin", "Scan Barcode Here")

    '~~> Prompt User To Actually input data if they have not entered anything
    If Len(Trim(removebox)) = 0 Then
        MsgBox "Please enter barcode", vbCritical, "Please Try again"
        Exit Sub
    End If

    '~~> Find the next blank row
    iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

    ws.Cells(iRow, 1).Value = Left(removebox, 6)
    ws.Cells(iRow, 2).Value = Mid(removebox, 7, 8)

    Select Case Len(removebox)
        '~~> For 20 digit barcodes split into 4 parts and record
        '~~> the data in the next blank row'
        Case 20
            ws.Cells(iRow, 3).Value = Mid(removebox, 9)
            ws.Cells(iRow, 4).Value = Mid(removebox, 10, 20)
        '~~> For 18 Digit barcodes spilt into 3 parts and record
        '~~> the data in the next blank row'
        Case 18
            ws.Cells(iRow, 3).Value = Mid(removebox, 9, 18)
        '~~> If not 20 or 18 digit then it is 16, split into 3
        '~~> parts and record the data in the next blank row'
        Case Else
            ws.Cells(iRow, 3).Value = Mid(removebox, 9, 18)
    End Select
End Sub