2017-11-12 3 views
-1

현재 수정 된 엑셀 일정 워크 북을 많이 수정하고 있습니다. 나는 치료사 (치료사 선택자 시트)의리스트 마스터리스트를 가지고 있는데, 체크 박스가 체크되고 마법 버튼이 눌려지면, 지정된 범위의 목표 시트 (모든 치료사)에서 이름을 확인하기를 원합니다.VBA에서 ArrayList 사용

치료사가 선택 취소 된 경우 프로그램에서 프로그램은 그 행에 필요한 데이터를 지우고 모든 것을 정렬합니다. 그 부분은 잘 작동합니다.

다음으로 프로그램은 다음 공개 장소에 아직없는 이름을 넣기를 원합니다. 나는 처음에 ArrayList에 의해 검사를하는 모든 이름을 채워서이 작업을 수행하려고합니다.

프로그램에서 중복을 발견하면 배열에서 중복을 제거해야합니다. 그런 다음 중복을 제거하면 이름을 반복하고 하이픈으로 열의 첫 번째 셀에있는 각 셀을 인쇄합니다 (모든 빈 셀은 하이픈으로 바뀝니다).

이 기능을 사용할 수 없습니다. 나는

런타임 오류 -2146233079가 계속 80,131,509

사람이 처리 할 수있는 더 좋은 방법을 볼 수 있습니까? 또는 적어도 내가 어디로 잘못 가고 있는지 보지 않겠습니까?

제 1 서브 정렬을 취소하고 제 2 서브를 호출

Private Sub AddDailyTherapists(PasteToRange As range, TrueFalseRange As range, StartCell As range, SortRange As range) 
    Call ClearUnselectedTherapists(PasteToRange, TrueFalseRange, StartCell, SortRange) 
    Dim Names As Object 
    Set Names = CreateObject("System.Collections.ArrayList") 
    For Each cel In TrueFalseRange 
     If cel.value = True Then 
      Names.Add cel.Parent.Cells(cel.Row, 4).value 
     End If 
    Next cel 
    For Each n In PasteToRange 
     For Each nm In Names 
      If nm = n.value Then 
       Names.Remove nm 
      End If 
     Next nm 
    Next n 
    StartCell.Activate 
    For Each nm In Names 
     Do While (ActiveCell.value <> "-") 
      ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate 
     Loop 
     ActiveCell.value = nm 
    Next nm 
End Sub 

Public Sub ClearUnselectedTherapists(PasteToRange As range, TrueFalseRange As range, StartCell As range, SortRange As range) 
    Sheets("All Therapists").Activate 
    StartCell.Activate 
    For Each cell In TrueFalseRange 
     If cell.value = False Then 
      Name = cell.Parent.Cells(cell.Row, 4).value 
      For Each cel In PasteToRange 
       If Name = cel.value Then 
        cel.value = "-" 
        cel.Offset(0, 1).range("A1:R1").Select 
        Selection.ClearContents 
        Exit For 
       End If 
      Next cel 
     End If 
    Next cell 
    With ActiveWorkbook.Worksheets("All Therapists").Sort 
     .SetRange SortRange 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 
End Sub 

수정 된 스프레드 시트 :

spreadsheet that is modified

체크 박스와 시트 :

Spreadhsheet with checkboxes

+1

오류를 정확히내는 행은 어느 것입니까? –

+0

다음 NM 제거 루프. – benjaminhmlucas

+0

배열 목록 대신 배열로 처리 할 수있게되었습니다. – benjaminhmlucas

답변

0
Private Sub AddDailyTherapists(PasteToRange As range, TrueFalseRange As range, StartCell As range, SortRange As range) 
' 
Call ClearUnselectedTherapists(PasteToRange, TrueFalseRange, StartCell, SortRange) 

Dim Names(0 To 11) As String 
i = 0 
For Each cel In TrueFalseRange 
    If cel.value = True Then 
     Names(i) = cel.Parent.Cells(cel.Row, 4).value 
     i = i + 1 
    End If 
Next cel 
For Each n In PasteToRange 
    For j = 0 To UBound(Names) 
     If Names(j) = n.value Then 
      Names(j) = "" 
     End If 
    Next j 
Next n 
StartCell.Activate 
For k = 0 To UBound(Names) 
    Do While (ActiveCell.value <> "-") 
     ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate 
    Loop 
    If Names(k) <> "" Then 
     ActiveCell.value = Names(k) 
    End If 
Next k 

End Sub