Question

我正在使用条形码扫描仪进行大量库存，我想将数据输入excel。我可以改变扫描仪在每次扫描后的行为方式来执行标签，返回等操作。但我的大问题是，为了有效地提供数量，我必须扫描项目代码（7位数），然后扫描数量从0到9连续。这样548实际上是5,4,8，当使用excel时，它将每个数字放入一个新的单元格中。我想做什么，但没有VBA印章来做它是excel检查，看看长度是7位还是一位数。对于每个一位数字，它应该将数字移动到与前一个7位数字相同的行中的下一个单元格，使得每个连续的一位数字被组合，就像excel连接单元格一样。然后它应删除原始列中的单个数字，并使下一行以7位数的条形码编号开始。

我希望这是有道理的。

示例：

应该成为：

| 7777777 | 345 |
| 7777778 | 456 |
| 7777779 | 789 |

谢谢！

Answer 1

我设置了这样的工作表：

enter image description here

然后运行以下代码

Sub Digits()
Application.ScreenUpdating = False
    Dim i&, r As Range, j&
    With Columns("B:B")
        .ClearContents
        .NumberFormat = "@"
    End With
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Set r = Cells(i, 1)
        If Len(r) = 7 Then
            j = 1
            Do Until ((Len(r.Offset(j, 0).Text) = 7) Or (IsEmpty(r.Offset(j, 0))))
               Cells(i, 2) = CStr(Cells(i, 2).Value) & CStr(r.Offset(j, 0))
                j = j + 1
            Loop
        End If
        Set r = Nothing
    Next
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        If Len(Cells(i, 1)) < 7 Then Rows(i & ":" & i).Delete
    Next i
    Columns.AutoFit
Application.ScreenUpdating = True
End Sub

我得到的结果：

enter image description here

Answer 2

这就是我对你开始做的事情，但我认为你的新解决方案会更好。非常感谢你！

Sub Digits()

Application.ScreenUpdating = False

    Dim i, arr, r As Range
    Dim a, b, c, d, e
    Dim y
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Set r = Cells(i, 1)
        Set a = Cells(i + 1, 1)
        Set b = Cells(i + 2, 1)
        Set c = Cells(i + 3, 1)
        Set d = Cells(i + 4, 1)
        Set e = Cells(i + 5, 1)
        If Len(a) = 7 Then
            y = 0
        ElseIf Len(b) = 7 Then
            y = 1
        ElseIf Len(c) = 7 Then
            y = 2
        ElseIf Len(d) = 7 Then
            y = 3
        ElseIf Len(e) = 7 Then
            y = 4
        Else:
            y = 0
        End If
        If Len(r) = 7 Then
            arr = Range("A" & i & ":A" & i + y).Value
            Range("B" & i & ":F" & i) = WorksheetFunction.Transpose(arr)
        End If
    Next
    Cells.Replace "#N/A", "", xlWhole
Application.ScreenUpdating = True

End Sub

Excel条形码扫描仪列数据到行

2 个答案: