1

バーコード スキャナーを使用して大量の棚卸を行っており、そのデータを Excel に入力したいと考えています。タブ、リターンなどを行うために、各スキャン後にスキャナーの動作を変更できますが、私の大きな問題は、数量を効率的に提供するために、商品コード (7 桁) をスキャンしてから、連続して 0 から 9 までの量。548 は実際には 5、4、8 であり、Excel を使用すると、各数値が新しいセルに入れられます。私がやりたいことは、VBA チョップがありません。それは、長さが 7 桁か 1 桁かを確認するために Excel チェックを行うことです。1桁の数字ごとに、前の7桁の数字と同じ行の次のセルに数字を移動して、連続する1桁の数字がExcelでセルを連結しているかのように結合する必要があります。

これが理にかなっていることを願っています。

例：

7777777
3
4
5
7777778
4
5
6
7777779
7
8
9

次のようになる必要があります。

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

ありがとう！！

4

2 に答える 2

0

ワークシートを次のように設定しました。

ここに画像の説明を入力

次に、以下のコードを実行しました

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

そして私が得た結果：

ここに画像の説明を入力

于 2013-09-09T08:37:01.893 に答える
0

これはあなたが始めたことで私がしたことですが、あなたの新しいソリューションの方がうまくいくと思います. ありがとうございます！

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
于 2013-09-10T17:41:49.333 に答える