集成string文本分割器函数和worksheet_change的Excel问题

我正在尝试编写一段代码，可以自动将从即插即用扫描程序扫描的数据与二维条码分开。 数据是这种格式“SN1234567 7654321 PA01234-5 ABC”，我需要每个文本/数字块到每个自己的单元格。 现在我成功地在网上find一个macros来分割这个文本（如下所示），并且在将数据input到A1时，macros也会自动运行macros（而不是我的macros）。 问题是我不能得到worksheet_change分工与我的分裂文字macros。 代码如下所示

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

我修改了一些代码来使用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 

Answer 3

一旦单元格被更改， 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