[已解决]二组VBA代码整合

wwj804

各位老师好，有二组VBA代码，想整合在一起，可是不会做，怎样做？

代码1：
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim a
    If Target.Row <> 2 Then
    Exit Sub
    Else
        a = Target.Column
        Sheets("汇总").Cells(a - 7, 5) = Target
    End If
End Sub

代码2：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row < 3 Or Target.Column <> 5 Or Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If Len(Target) = 0 Then Target.EntireRow = ""
    arr = Sheet8.[a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        d(CStr(arr(i, 1))) = i
    Next
    i = d(CStr(Target.Value))
    If i > 0 Then
        Target.Offset(, 1) = arr(i, 4)
        Target.Offset(, 2) = arr(i, 9)
    End If
        
    Application.EnableEvents = True
End Sub

最佳答案

月排行榜 / 总排行榜

france723

2017-5-12 15:07

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim a
   
3.     If Target.Row <> 2  Then
   
4.         If Target.Row < 3 Or Target.Column <> 5 Or Target.Count > 1 Then
   
5.             Exit Sub
   
6.         Else
   
7.             Application.EnableEvents = False
   
8.             If Len(Target) = 0 Then Target.EntireRow = ""
   
9.             arr = Sheet8.[a1].CurrentRegion
   
10.             Set d = CreateObject("scripting.dictionary")
    
11.             For i = 2 To UBound(arr)
    
12.                 d(CStr(arr(i, 1))) = i
    
13.             Next
    
14.             i = d(CStr(Target.Value))
    
15.             If i > 0 Then
    
16.                 Target.Offset(, 1) = arr(i, 4)
    
17.                 Target.Offset(, 2) = arr(i, 9)
    
18.             End If
    
19.             Application.EnableEvents = True
    
20.         End If
    
21.     Else
    
22.         a = Target.Column
    
23.         Sheets("01").Cells(a - 7, 5) = Target
    
24.     End If
    
25. End Sub

复制代码

跳转到最佳答案楼层

france723

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim a
   
3.     If Target.Row <> 2  Then
   
4.         If Target.Row < 3 Or Target.Column <> 5 Or Target.Count > 1 Then
   
5.             Exit Sub
   
6.         Else
   
7.             Application.EnableEvents = False
   
8.             If Len(Target) = 0 Then Target.EntireRow = ""
   
9.             arr = Sheet8.[a1].CurrentRegion
   
10.             Set d = CreateObject("scripting.dictionary")
    
11.             For i = 2 To UBound(arr)
    
12.                 d(CStr(arr(i, 1))) = i
    
13.             Next
    
14.             i = d(CStr(Target.Value))
    
15.             If i > 0 Then
    
16.                 Target.Offset(, 1) = arr(i, 4)
    
17.                 Target.Offset(, 2) = arr(i, 9)
    
18.             End If
    
19.             Application.EnableEvents = True
    
20.         End If
    
21.     Else
    
22.         a = Target.Column
    
23.         Sheets("01").Cells(a - 7, 5) = Target
    
24.     End If
    
25. End Sub

复制代码

wwj804

谢谢啦