VBA抽签分组立即显示队名到分组中去

odyssey166

odyssey166 发表于 2020-1-29 10:37
老师你好：

昨天您解决了我的问题。

我这样改写了一下，但第2个项目抽签开始时，只能填入一个队后，代码就不再运行了。怎么点都不运行。

odyssey166

odyssey166 发表于 2020-1-29 12:27
我这样改写了一下，但第2个项目抽签开始时，只能填入一个队后，代码就不再运行了。怎么点都不运行。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count <> 1 Then Exit Sub
    If Target.Row < 3 Then Exit Sub
    If Cells(Target.Row, 5) = "" Then Exit Sub
   
    If Target.Column = 6 Then                                  'Exit Sub
   
      Application.EnableEvents = False
      If Target = "" Then
        Cells(Target.Row, 7) = ""
      Else
        
        Cells(Target.Row, 7) = "第" & WorksheetFunction.CountIf([f3:f14], Target) & "个" & Target
        
        For j = Target * 4 - 1 To Target * 4 + 2
            
            If Len(Cells(j, 2)) = 0 Then
               
                Cells(j, 2) = Cells(Target.Row, 5)
               
                Exit For
            
            End If
        Next j
    End If
   
    Else
   
   
    If Target.Column = 8 Then                                  'Exit Sub
   
      Application.EnableEvents = False
      If Target = "" Then
        Cells(Target.Row, 9) = ""
      Else
        
        Cells(Target.Row, 9) = "第" & WorksheetFunction.CountIf([H3:H14], Target) & "个" & Target
        
        For K = Target * 4 - 1 To Target * 4 + 2
            
            If Len(Cells(K, 3)) = 0 Then
               
                Cells(K, 3) = Cells(Target.Row, 5)
               
                Exit For
            
            End If
        Next K
    End If
   
    Else
   
    Exit Sub
   
    End If
   
    Exit Sub
   
    End If
   
    Application.EnableEvents = True
   
End Sub

odyssey166

odyssey166 发表于 2020-1-29 12:28
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count  1 Then Exit Sub
    If  ...

这是改写的附件，麻烦老师帮看看哪 里有问题？

odyssey166

odyssey166 发表于 2020-1-29 12:31
这是改写的附件，麻烦老师帮看看哪 里有问题？

已经搞定，删去最后的两个exit sub，就可以了。

odyssey166

odyssey166 发表于 2020-1-29 13:07
已经搞定，删去最后的两个exit sub，就可以了。

哦，好的，谢谢提醒！