[已解决]重新求助一下

171774040 · 发表于 2017-7-9 12:35

请看附件谢谢！！！！！！

最佳答案

grf1973

2017-7-10 11:35

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Row < 8 Or Target.Column <> 4 Then Exit Sub
r = Target.Row: x = Cells(r, "x")
Set d = CreateObject("scripting.dictionary")
Application.EnableEvents = False
If x <> "" Then
With Sheets("3")
For c = 1 To .Cells(1, 256).End(xlToLeft).Column
d(.Cells(1, c).Value) = ""
Next
For c = 1 To .Cells(1, 256).End(xlToLeft).Column
If .Cells(1, c) = "" Then Exit For
Next
If Not d.exists(x) Then .Cells(1, c).Resize(3) = Application.Transpose(Array(x, "甲", "乙"))
End With
End If
Application.EnableEvents = True
End Sub

复制代码

171774040 · 发表于 2017-7-9 16:03

自己顶上去

171774040 · 发表于 2017-7-9 20:26

自己再顶

grf1973 · 发表于 2017-7-10 11:35

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Row < 8 Or Target.Column <> 4 Then Exit Sub
r = Target.Row: x = Cells(r, "x")
Set d = CreateObject("scripting.dictionary")
Application.EnableEvents = False
If x <> "" Then
With Sheets("3")
For c = 1 To .Cells(1, 256).End(xlToLeft).Column
d(.Cells(1, c).Value) = ""
Next
For c = 1 To .Cells(1, 256).End(xlToLeft).Column
If .Cells(1, c) = "" Then Exit For
Next
If Not d.exists(x) Then .Cells(1, c).Resize(3) = Application.Transpose(Array(x, "甲", "乙"))
End With
End If
Application.EnableEvents = True
End Sub

复制代码

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