Question

我试图编写一段代码，自动将插入和播放扫描仪中扫描的数据与2D条形码分开。数据采用这种格式＆＃34; SN1234567 7654321 PA01234-5 A B C＆＃34;我需要每个文本/数字块进入每个单元格。现在我成功地在线找到了一个宏来分割这个文本（如下所示），还有一个宏在自动运行A（不是我的宏）宏时将数据输入A1。问题是我无法使用worksheet_change子工作与我的splittext宏。代码如下所示

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:C10")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
       Is Nothing Then

    ' Display a message when one of the designated cells has been
    ' changed.
    ' Place your code here.
    MsgBox "Cell " & Target.Address & " has changed."
    Call textsplit

End If
End Sub

Sub textsplit()
Dim text As String
Dim a As Integer
Dim name As Variant
text = ActiveCell.Value
name = Split(text, " ")
For a = 0 To UBound(name)
    Cells(1, a + 1).Value = name(a)
Next a
End Sub

Answer 1

你想要分割值的位置并不是很清楚，但这些方面的东西可以起作用：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range, rng As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("A1:C10")

    'Target can be a multi-cell range, so you need to account
    '  for that possibility
    Set rng = Application.Intersect(KeyCells, Target)

    If Not rng Is Nothing Then

        ' Display a message when one of the designated cells has been
        ' changed.
        ' Place your code here.
        Debug.Print "Cell " & Target.Address & " has changed."

        'prevent re-activating this sub when splitting text...
        Application.EnableEvents = False
        textsplit Target
        Application.EnableEvents = True
    End If

    Exit Sub

haveError:
    Application.EnableEvents = True

End Sub


Sub textsplit(rng As Range)
    Dim c As Range, arr

    For Each c In rng.Cells
        If Len(c.Value) > 0 Then
            arr = Split(c.Value, " ")
            c.Offset(0, 1).Resize(1, UBound(arr) + 1).Value = arr
        End If
    Next c

End Sub

Answer 2

更改单元格后，ActiveCell不再是目标。发送Sub目标，见下文：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:C10")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
       Is Nothing Then

    ' Display a message when one of the designated cells has been
    ' changed.
    ' Place your code here.
    MsgBox "Cell " & Target.Address & " has changed."
    Call textsplit(Target)

End If
End Sub

Sub textsplit(Target)
Dim text As String
Dim a As Integer
Dim name As Variant
text = Target.Value
name = Split(text, " ")
For a = 0 To UBound(name)
    Cells(1, a + 1).Value = name(a)
Next a
End Sub

Answer 3

我修改了一些代码以使用TextToColumns而不是有效的textsplit（）。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

Set KeyCells = Range("A1:C10")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
        Is Nothing Then     
    MsgBox "Cell " & Target.Address & " has changed."
    Target.TextToColumns Destination:=Range(Target.Address), DataType:=xlDelimited, Space:=True

End If
End Sub

Excel集成字符串文本拆分器功能和worksheet_change的问题

3 个答案: