VBA 单元格变化时调用宏拆分单元格
VBA call macro to split cells when cell changes
正在尝试制作一个自动调用另一个宏以提取部分输入字符串并插入到其他两个单元格中的宏。拆分宏在单元格上手动调用时有效,但无法自动触发。
Sub splitEnvServ()
'
' Macro3 Macro
'
'
Selection.TextToColumns destination:=ActiveCell.Offset(, 2), DataType:=xlDelimited, \_
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, \_
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar \_
\:="/", FieldInfo:=Array(Array(1, 9), Array(2, 9), Array(3, 9), Array(4, 9), Array(5, \_
9), Array(6, 9), Array(7, 9), Array(8, 9), Array(9, 9), Array(10, 9), Array(11, 9), Array(12 \_
, 9), Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(17, 9), Array(18, 9)), \_
TrailingMinusNumbers:=True
End Sub
'
' Part that won't trigger
'
'
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("B13")) Is Nothing Then splitEnvServ
End Sub
在您的子程序中,您缺少 End if。
尝试:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("B13")) Is Nothing Then
splitEnvServ
End If
End Sub
工作表更改:将单元格拆分为行
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ClearError
Const cAddress As String = "B13"
Dim iCell As Range: Set iCell = Intersect(Range(cAddress), Target)
If iCell Is Nothing Then Exit Sub
Application.EnableEvents = False
SplitEnvServ iCell
SafeExit:
On Error Resume Next
If Not Application.EnableEvents Then Application.EnableEvents = True
On Error GoTo 0
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub
Sub SplitEnvServ(ByVal Cell As Range)
Const Delimiter As String = "/"
Const ColumnOffset As Long = 1
With Cell.Offset(, ColumnOffset)
Dim lCell As Range: Set lCell = .Resize(, Columns.Count - .Column + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If Not lCell Is Nothing Then
.Resize(, lCell.Column - .Column + 1).ClearContents
End If
End With
Dim Sentence As String: Sentence = CStr(Cell.Value)
If Len(Sentence) = 0 Then Exit Sub
Dim Words() As String: Words = Split(Sentence, Delimiter)
Cell.Offset(, ColumnOffset).Resize(, UBound(Words) + 1).Value = Words
End Sub
正在尝试制作一个自动调用另一个宏以提取部分输入字符串并插入到其他两个单元格中的宏。拆分宏在单元格上手动调用时有效,但无法自动触发。
Sub splitEnvServ()
'
' Macro3 Macro
'
'
Selection.TextToColumns destination:=ActiveCell.Offset(, 2), DataType:=xlDelimited, \_
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, \_
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar \_
\:="/", FieldInfo:=Array(Array(1, 9), Array(2, 9), Array(3, 9), Array(4, 9), Array(5, \_
9), Array(6, 9), Array(7, 9), Array(8, 9), Array(9, 9), Array(10, 9), Array(11, 9), Array(12 \_
, 9), Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(17, 9), Array(18, 9)), \_
TrailingMinusNumbers:=True
End Sub
'
' Part that won't trigger
'
'
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("B13")) Is Nothing Then splitEnvServ
End Sub
在您的子程序中,您缺少 End if。 尝试:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("B13")) Is Nothing Then
splitEnvServ
End If
End Sub
工作表更改:将单元格拆分为行
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ClearError
Const cAddress As String = "B13"
Dim iCell As Range: Set iCell = Intersect(Range(cAddress), Target)
If iCell Is Nothing Then Exit Sub
Application.EnableEvents = False
SplitEnvServ iCell
SafeExit:
On Error Resume Next
If Not Application.EnableEvents Then Application.EnableEvents = True
On Error GoTo 0
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub
Sub SplitEnvServ(ByVal Cell As Range)
Const Delimiter As String = "/"
Const ColumnOffset As Long = 1
With Cell.Offset(, ColumnOffset)
Dim lCell As Range: Set lCell = .Resize(, Columns.Count - .Column + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If Not lCell Is Nothing Then
.Resize(, lCell.Column - .Column + 1).ClearContents
End If
End With
Dim Sentence As String: Sentence = CStr(Cell.Value)
If Len(Sentence) = 0 Then Exit Sub
Dim Words() As String: Words = Split(Sentence, Delimiter)
Cell.Offset(, ColumnOffset).Resize(, UBound(Words) + 1).Value = Words
End Sub