Excel2003代码问题，非常感谢！

LSYYLW

拜托老师了！

2019-4-29-.zip (2.3 KB, 下载次数: 2)

2019-4-29 12:52 上传

点击文件名下载附件

一把小刀闯天下

'试一下，加了一个复位过程，，，

Option Explicit

Dim flag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
  If CDec(Target.Rows.Count) * Target.Columns.Count > 1 Then Exit Sub
  If Target.Address = "$B$2" Then
    If flag Then
      If Len([f2].Value) Then
        [d2].Value = [d2].Value + 1
      Else
        [f2].Value = 1: [d2].Value = 0
      End If
    Else
      flag = True: [f2].Value = 1: [d2].Value = 0
    End If
  End If
End Sub

Sub resst()
  flag = False
  [f2].ClearContents
End Sub

l_jiashi

vba sheet1 加入如下代码，仅供参考

1. Dim a&
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     Dim b&
   
4.     If Target.Address = "$B$2" Then
   
5.         If a = 0 Then
   
6.             a = Target.Value
   
7.         End If
   
8.         b = Target.Value
   
9.         'MsgBox a & "===" & b
   
10.         
    
11.         If a = b Then
    
12.             If Me.Range("F2") = "" Then
    
13.                 Me.Range("D2") = 0
    
14.             End If
    
15.         Else
    
16.             If Me.Range("F2") = "" Then
    
17.                 Me.Range("F2") = 1
    
18.                 Me.Range("D2") = 0
    
19.             ElseIf Me.Range("F2") = 1 Then
    
20.                 Me.Range("D2") = Me.Range("D2") + 1
    
21.             End If
    
22.             
    
23.             a = b
    
24.         End If
    
25.     End If
    
26. End Sub

复制代码

一把小刀闯天下

'[f2]手动输入，另外当[b2]当前值与上次值不同时才作处理

'觉得条件并不够，另外逻辑上好像也有点问题，自己试一下，，，

Option Explicit

Dim flag As Boolean, lastvalue

Private Sub Worksheet_Change(ByVal Target As Range)
  If CDec(Target.Rows.Count) * Target.Columns.Count > 1 Then Exit Sub
  If Target.Address = "$B$2" Then
    If Len([f2].Value) = 0 Then
      flag = False: lastvalue = vbNullString: [d2].Value = 0: Exit Sub
    End If
    If lastvalue <> [b2].Value Then
      If flag Then
        If [d2].Value = 20 Then
          [d2].Value = 0
        Else
          [d2].Value = [d2].Value + 1
        End If
      Else
        flag = True: [d2].Value = 0
      End If
      lastvalue = [b2].Value
    End If
  End If
End Sub

Sub reset()
  flag = False: [f2].ClearContents
  [d2].Value = 0: lastvalue = vbNullString
End Sub

LSYYLW

2019-4-29.zip (5.06 KB, 下载次数: 2)

2019-4-29 15:20 上传

点击文件名下载附件

LSYYLW

一把小刀闯天下 发表于 2019-4-29 14:06
'[f2]手动输入，另外当当前值与上次值不同时才作处理

'觉得条件并不够，另外逻辑上好像也有点问题，自己 ...

非常感谢老师，还差一点点就解决我的问题了，我又修改了一下提问，啰嗦了一些，不知老师能不能看懂，表达能力差，让老师您多费心了，深表歉意，附件在5楼，拜托老师了！

LSYYLW

l_jiashi 发表于 2019-4-29 13:25
vba sheet1 加入如下代码，仅供参考

非常感谢老师，本版的问题我没有表述清楚，我又重新编写了一下，附件在5楼，麻烦老师您再帮我看一下，拜托了！

lsdongjh

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim strF2 As String, strAddress As String
   
3.     Dim rgD2 As Range
   
4.    
   
5.     strF2 = Trim(Range("F2").Value)
   
6.     strAddress = Target.Address(0, 0)
   
7.     Set rgD2 = Range("D2")
   
8.    
   
9.     Select Case strAddress
   
10.         Case "F2"
    
11.             If strF2 = "" Then
    
12.                 Application.EnableEvents = False
    
13.                 rgD2.Value = 0
    
14.                 Application.EnableEvents = True
    
15.             End If
    
16.         Case "B2"
    
17.             If strF2 = "1" Then
    
18.                 Application.EnableEvents = False
    
19.                 rgD2.Value = rgD2.Value + 1
    
20.                 Application.EnableEvents = True
    
21.             End If
    
22.     End Select
    
23. End Sub

复制代码

LSYYLW

2019-4-29----.zip (7.52 KB, 下载次数: 2)

2019-4-29 16:46 上传

点击文件名下载附件

LSYYLW

lsdongjh 发表于 2019-4-29 15:46

非常感谢老师，测试您的代码时，发现我的问题忘了加一个条件，就是9楼附件里黄颜色单元格里面的字要求的，拜托老师您再帮我看看，非常感谢！