VBA 필터링 된 셀 선택

Question

시트에 사용자 정의 폼이 있습니다. 이 양식에는 6 개의 콤보 박스가 있습니다.

이 콤보 박스는 6 개의 열이있는 시트에서 채워지며 각 열은 콤보 박스로 이동합니다. 각 콤보 박스를 선택한 후이 시트에서 필터를 만들고 다음 시트를 다시 채 웁니다.

더 명확하게하려고하는 예를 들어 보겠습니다.

나는 6 개의 열이있는 시트가 있습니다.
대륙 | 국가 | 주 | 시 | 거리 | 건물 이름

이 시트에는이 모든 itens에 가능한 모든 조합이 있습니다. 예 : 거리의 각 건물에 대해 동일한 5 개의 첫 번째 항목과 마지막 항목이 모두있는 행이 있습니다.

사용자가 양식을 열면 첫 번째 콤보 상자가 시트의 첫 번째 열로 채워집니다 (고유 한 항목을 가져 오는 루틴을 수행함). 사용자가 첫 번째 콤보 상자를 변경하면 첫 번째 열의 시트에 필터를 적용한 다음 두 번째 콤보 상자에 필터링 된 시트를 채 웁니다.

내 문제는 필터링 된 범위를 얻는 방법입니다. 내가이 일을 해요 :...

lastRow = 시트 ("SIP")를 범위 ("A65536") 종료 (xlUp)를 셀에만
lFiltered = 시트 ("SIP") 범위 ("A2 : F "& lastRow) .SpecialCells (xlCellTypeVisible) .Cells

잘 작동합니다. 그러나 필터를 적용하면 예를 들어 행 10 만 숨기고 lFiltered 변수는 행 9까지만 반환됩니다. 첫 번째 숨겨진 행이 손상되어 그 이후에 행이 반환되지 않습니다.

나는 모든 행에 대해 foreach를 수행하고 표시 여부를 확인하지만 코드는 실제로 느리게 처리됩니다. 각 콤보 박스를 채우는 데 최대 10 초가 소요됩니다.

누구든지이 문제를 해결하려면 어떻게해야합니까?

대단히 감사합니다.

- 편집 - 여기

는

여기

내가 방식으로 작동하는 코드를 관리하는 방법입니다 --- 코드

Dim listaDados As New Collection 
Dim comboList() As String 
Dim currentValue As String 
Dim splitValue() As String 
Dim i As Integer 
Dim l As Variant 
Dim lFiltered As Variant 
Dim lastRow As Integer 

'Here I found the last row from the table 
lastRow = Sheets("SIP").Range("A65536").End(xlUp).Row 
'I do this because when the filter filters everything, lastRow = 1 so I got an erros on lFiltered range, it becames Range("A2:F1") 
If lastRow < 2 Then 
    lastRow = 2 
End If 
'Here I get an array with all the visible rows from the table -> lFiltered(row, column) = value 
lFiltered = Sheets("SIP").Range("A2:F" & lastRow).SpecialCells(xlCellTypeVisible).Cells 
'I have duplicated entries, so I insert everything in a Collection, so it only allows me to have one of each value 
on error resume next 
For i = 1 To UBound(lFiltered) 
    currentValue = Trim(lFiltered(i, column)) 
    If currentValue <> 0 Then 
     If currentValue <> "" Then 
      'Cammel case the string 
      currentValue = UCase(Left(currentValue, 1)) & LCase(Mid(currentValue, 2)) 
      'Upper case the content in between "()" 
      splitValue = Split(currentValue, "(", 2) 
      currentValue = splitValue(0) & "(" & UCase(splitValue(1)) 
      'Insert new item to the collection 
      listaDados.Add Item:=currentValue, Key:=currentValue 
     End If 
    End If 
Next i 
i = 1 
'Here I copy the collection to an array 
ReDim Preserve comboList(0) 
comboList(0) = "" 
For Each l In listaDados 
    ReDim Preserve comboList(i) 
    comboList(i) = l 
    i = i + 1 
Next l 

'Here I assign that array to the combobox 
formPerda.Controls("cGrupo" & column).List = comboList 

--- 편집의 중요한 부분입니다 내가 원하는.

'Get the last row the filter shows 
lastRow = Sheets("SIP").Range("A65536").End(xlUp).Row 
'To avoid to get the header of the table 
If lastRow < 2 Then 
    lastRow = 2 
End If 
'Get the multiple range showed by the autofilter 
Set lFilteredAux = Sheets("SIP").Range("A2:F" & lastRow).Cells.SpecialCells(xlCellTypeVisible) 

'Check if there is more than 1 no contiguous areas 
If Sheets("SIP").Range(lFilteredAux.Address).Areas.Count > 1 Then 
    'If Yes, do a loop through the areas 
    For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count 
     'And add it to the lFiltered array 
     ReDim Preserve lFiltered(i - 1) 
     lFiltered(i - 1) = Sheets("SIP").Range(lFilteredAux.Address).Areas(i) 
    Next i 
Else 
    'If there is only one area, it goes the old way 
    ReDim lFiltered(0) 
    lFiltered(0) = Sheets("SIP").Range(lFilteredAux.Address) 
End If 

지금 내가 사용하던 방법보다 조금 다르게 lFiltered 배열을 가지고,하지만 난 이런 식으로 일을 내 foreach는 적응 :

For i = 0 To UBound(lFiltered) 
     For j = 1 To UBound(lFiltered(i)) 
      currentValue = Trim(lFiltered(i)(j, columnNumber)) 
     next j 
next i 

감사합니다 많이!= D

Answer 1

나는 당신이 거기에서 설정 필요하다고 생각 :

Sub dural() 
    lastRow = Sheets("SIP").Range("A65536").End(xlUp).Row 
    Set lFiltered = Sheets("SIP").Range("A2:F" & lastRow).Cells.SpecialCells(xlCellTypeVisible) 
    MsgBox lFiltered.Address 
End Sub 

Answer 2

여기에 확실한 성능 싱크는 ReDim을 꽉 루프에서 보존 사용하는 것입니다.

설명하기 위해, 그 작은 ReDim Preserve 문은 많은 작업을 수행합니다. 크기가 4 인 배열을 가지고 있고 크기를 5로 바꾸면 5 개의 공백을 할당하고 이전 배열의 4 개 값을 복사합니다. 그런 다음 크기를 6으로 조정하면 여백을 6 개 할당하고 이전 배열의 5 개 값을 복사합니다.

총 1000 개의 값이 있다고합시다. 코드를 작성할 때 은으로 배열에 1000 개의 요소를 할당하고 복사하는 것으로 생각했습니다. 이것은 선형 시간, O (n) 연산 일 것입니다. 사실, 당신은 1 + 2 + 3 + 4 ... + 1000 요소 = 다항식 시간 인 O (n^2) 연산 인 500,000을 할당하고 복사하는 것을 할당하고있었습니다.

용액은 다음 중 하나

1) 외부 루프, 어레이의 크기를 파악하고 만 ReDim을 한번 보존.

처음이다

:

Dim totalSize as Long, i as Long 
For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count 
    totalSize += 1 
Next I 

그리고 당신은 크기가 일단 : 그 ReDim을 보존

ReDim Preserve lFiltered(totalSize - 1) 
For i = 1 To Sheets("SIP").Range(lFilteredAux.Address).Areas.Count 
    lFiltered(i - 1) = Sheets("SIP").Range(lFilteredAux.Address).Areas(i) 
Next i 

2) 대신 크기를 조정해야하는 배열을 사용하고를 특정 크기가 필요합니다 컬렉션을 사용하십시오. 내부적으로 콜렉션은 연결된 목록과 같이 구현됩니다. 즉 항목 추가는 일정 시간에 발생합니다 (각 작업에 대해 O (1), 모든 n 항목을 삽입하기 위해 O (n) 합계).