[已解决]求修改代码.

ttshertt · 发表于 2013-12-21 12:58

求修改代码.

最佳答案

hwc2ycy

2013-12-21 14:38

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim i As Integer
With Target
If .Count = 1 Then
If Len(.Value) Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Select Case .Column
Case 1
.Offset(0, 2).Value = .Value & "*" & .Offset(0, 1).Value & "=" & Format(Evaluate(.Value & "*" & .Offset(0, 1).Value), "0")
arr = Split(.Value, "*")
.Offset(0, 3).Value = "宽" & arr(0) & "米*高" & arr(1) & "米*" & arr(2) & "幅"
End Select
End If
Else
If .Column = 15 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = 1 To 19
If Left(Cells(i, "h"), Len(Target) + 1) = Target & "=" Then
.Offset(0, 1) = Replace(Cells(i, "h"), .Value & "=", "") & " " & .Offset(0, -1)
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
End If
Next
End If
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End With
End Sub

复制代码

hwc2ycy · 发表于 2013-12-21 14:38

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim i As Integer
With Target
If .Count = 1 Then
If Len(.Value) Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Select Case .Column
Case 1
.Offset(0, 2).Value = .Value & "*" & .Offset(0, 1).Value & "=" & Format(Evaluate(.Value & "*" & .Offset(0, 1).Value), "0")
arr = Split(.Value, "*")
.Offset(0, 3).Value = "宽" & arr(0) & "米*高" & arr(1) & "米*" & arr(2) & "幅"
End Select
End If
Else
If .Column = 15 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = 1 To 19
If Left(Cells(i, "h"), Len(Target) + 1) = Target & "=" Then
.Offset(0, 1) = Replace(Cells(i, "h"), .Value & "=", "") & " " & .Offset(0, -1)
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
End If
Next
End If
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End With
End Sub

复制代码

yyyydddd8888 · 发表于 2013-12-21 15:49

请测试：

计算求助.zip (8.67 KB, 下载次数: 6)

		自动登录	找回密码
密码			注册