从列中的单元格中删除多余的空格

Question

我编写了以下代码来进行库存扫描条形码，但由于某种原因，当我扫描条形码时，它会在单元格中添加额外的空格，结果不会按预期显示。

如何从列中的单元格中删除多余的空格？

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If Target.Cells.Count > 1 Or IsEmpty(Target) Or Target.Column <> 1 Then Exit Sub

    If Not SheetExists("WarehouseInventory") Then Exit Sub

    Dim result As Variant

    Set result = Sheets("WarehouseInventory").Cells.Range("E:E").Find(Target)

    If result Is Nothing Then
       Target.Worksheet.Cells(Target.Row, 2) = "Data Maybe Bin #?"
    Else
        Target.Worksheet.Cells(Target.Row, 2) = result.Worksheet.Cells(result.Row, 4)
        Target.Worksheet.Cells(Target.Row, 3) = result.Worksheet.Cells(result.Row, 5)
        Target.Worksheet.Cells(Target.Row, 4) = result.Worksheet.Cells(result.Row, 6)
        Target.Worksheet.Cells(Target.Row, 5) = result.Worksheet.Cells(result.Row, 7)
    End If

End Sub

Public Function SheetExists(SheetName As String) As Boolean
    Dim ws As Worksheet
    SheetExists = False

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = SheetName Then SheetExists = True
    Next ws

End Function

条形码将在A列上扫描

Answer 1

这是用于修剪额外空间的单元格的代码。

Dim cell As Range
For Each cell In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
cell = WorksheetFunction.Trim(cell)
Next cell

上面的代码将修剪ActiveSheet中的所有单元格。 选择要修剪的适当单元格，然后对它们应用修剪（单元格）。

Answer 2

  

当我扫描条形码时，它会在单元格中添加额外的空格，结果不会按预期显示。

我们的想法是不要在以后修剪所有单元格，而是在扫描时修剪条形码条目。这是你想要的吗？把它放在相关表格的代码区域。我假设条形码将在Col B中扫描到E。

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    If Target.Cells.Count > 1 Then Exit Sub

    Application.EnableEvents = False

    '~~> Assuming that the bar code is scanned in B to E
    '~~> If it is Just one column like B then change
    '~~> The code below to
    '~~> If Not Intersect(Target, Columns("B:B")) Is Nothing Then    
    If Not Intersect(Target, Columns("B:E")) Is Nothing Then
        Target.Value = Trim(Target.Value)
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub