2014-09-01 2 views
1

일부 데이터 유효성 검사 드롭 다운 목록을 채우고 있습니다. 그 값은 테이블에 있습니다.
사용자가 테이블에 항목을 추가 할 수있는 단추 (userforms에 대한 링크)가 있습니다. 새 값을 입력하면 시트의 Worksheet_Change 코드가 테이블을 정렬합니다.
값이 삭제되면 표의 크기가 조정됩니다.Worksheet_Change 코드를 지연시킬 수 있습니까? Excel Vba

하지만 이제 내 문제는 userform의 버튼을 처음 클릭 할 때 행이 테이블에 추가 된 다음 그 값이 해당 행에 추가되는 경우입니다. 값을 추가하기 전에 Worksheet_Change가 이미 새 빈 행을 감지하여 삭제했습니다.
지연시킬 수 있습니까, 아니면 더 나은 해결책을 알고 있습니까?

정의 폼에 대한 코드 :

Private Sub butAddProject_Click() 

    Dim listSheet As Worksheet 
    Dim listTable As listObject 
    Dim newRow As ListRow 
    Dim ProjectName As String 

    ProjectName = txtAddProject.Text 

    Set listSheet = Sheets("Projects-Tasks") 
    Set listTable = listSheet.ListObjects(1) 

    If ProjectName <> "" Then 
     Set newRow = listTable.ListRows.Add 
     newRow.Range(1, 1).Value = ProjectName 
    Else 
     MsgBox "Enter a project name first!" 
    End If 

    txtAddProject.Text = "" 
    formAddProject.Hide 

End Sub 

그리고 Worksheet_Change에 대한 마지막 코드 : 사전에

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim ws As Worksheet 
    Dim strList As String 
    Set ws = Sheets("Projects-Tasks") 
    strList = Cells(2, Target.Column).listObject.Name 

    If strList <> "" Then 
     Application.ScreenUpdating = False 
      With ListObjects(strList).Sort 
       .SortFields.Add _ 
        Key:=Cells(3, Target.Column), _ 
        SortOn:=xlSortOnValues, _ 
        Order:=xlAscending 
       .Header = xlYes 
       .MatchCase = False 
       .Orientation = xlTopToBottom 
       .SortMethod = xlPinYin 
       .Apply 
      End With 

     With ws.ListObjects(strList) 
      .Resize .DataBodyRange.CurrentRegion 
     End With 

    End If 

    Application.ScreenUpdating = True 

End Sub 

감사합니다! 새 행을 추가하는 동안 떨어져

+0

'Target.Value = ""'를 확인할 수 있습니까? – RubberDuck

+0

죄송합니다. 어떻게 생각하세요? –

+0

변경된 셀 (예 : '대상')이 비어 있다면 논리의 나머지 부분을 무시할 수 있습니까? – RubberDuck

답변

2

전원을 켜고 이벤트 :

If ProjectName <> "" Then 
    application.enableevents = False 
    Set newRow = listTable.ListRows.Add 
    application.enableevents = True 
    newRow.Range(1, 1).Value = ProjectName 
Else 

나는 당신이 아직도 내가 새 값을 추가 라인 전에 이벤트를 재설정 할 수 있도록 새 값을 추가 할 때 정렬 할 가정합니다.

+0

감사합니다 thats 코드 메신저 찾고! –

+0

이벤트가 항상 다시 켜지도록 오류 처리기를 추가 할 수 있습니다. – RubberDuck

1
Private Sub butAddProject_Click() 

    Dim listSheet As Worksheet 
    Dim listTable As listObject 
    Dim newRow As ListRow 
    Dim ProjectName As String 

    Application.EnableEvents=False 

    ProjectName = txtAddProject.Text 

    Set listSheet = Sheets("Projects-Tasks") 
    Set listTable = listSheet.ListObjects(1) 

    If ProjectName <> "" Then 
     Set newRow = listTable.ListRows.Add 
     newRow.Range(1, 1).Value = ProjectName 
    Else 
     MsgBox "Enter a project name first!" 
    End If 

    txtAddProject.Text = "" 
    formAddProject.Hide 

    Application.EnableEvents=True 


End Sub 
+0

고마워 그 코드 메신저 찾고있어! –

관련 문제