모든 정보를 복사하는 대신 복사 할 정보가없는 경우 어떻게 코드를 빠져 나갈 수 있습니까?

Question

좋아,이 질문에 대해 설명하는 것이 다소 어려웠지만 특정 값에 대해 Excel에서 만든 데이터베이스를 필터링하고 해당 섹션에 복사하는 Excel 스프레드 시트가 있습니다. 나는 대략 10 개의 섹션을 가지고 있고 마지막 두 개는 Adders이다. & 테이크 아웃 (Take-Outs) 테이크 아웃 (Take-Outs) 테이크 아웃 (Take-Outs) 테이크 아웃은 특정 시스템 크기에 데이터베이스에 항목이 없기 때문에 Adders를 필터링하도록 지시하면 데이터베이스에 항목이 없다. 그래서 데이터베이스의 모든 항목을 복사합니다 (이유를 모르겠습니다). 다음은 Adders 섹션에 대한 코드입니다.

'To add Adders 
Range("B12").Select 
Selection.End(xlDown).Select 
ActiveCell.Offset(1, 0).Select 
Selection.Font.Bold = True 
Selection.Font.Underline = xlUnderlineStyleSingle 
ActiveCell.FormulaR1C1 = "ADDERS" 
ActiveCell.Offset(1, 15).Select 
ActiveCell.FormulaR1C1 = "ADDERS" 
ActiveCell.Offset(-1, -15).Select 
'To filter data 
Sheets("Database").Select 
ActiveSheet.ListObjects("Database").Range.AutoFilter Field:=5, Criteria1:="4600", Operator:=xlOr, Criteria2:="All" 
ActiveSheet.ListObjects("Database").Range.AutoFilter Field:=6, Criteria1:="Adder" 
ActiveSheet.ListObjects("Database").Range.AutoFilter Field:=7, Criteria1:=Array("6201", "6201 Elec", "6201 Eng", "6201 FS Rad", "6201 FS SW", "6201 Rad", "6201 SII", "6201 Train", "CH Elec", "CH Eng", "CH FS", "CH High", "CH SII", "CH Std", "CH SW", "CM", "CM Eng", "Coiler", "Elec", "Elec Eng", "Eng", "ES", "Fluids Eng", "FM", "FS Elec", "FS SII", "FS SW", "Launder", "MA", "MA FS", "MA SII", "MA Train", "ML", "PMDA", "PP High", "PP Low", "QS", "Selee", "Selee Eng", "SII", "STAS", "STAS FS", "Train"), Operator:=xlFilterValues 
'To select correct data to copy 
Application.Run ("SelectDataToCopy") 
'To copy data 
Sheets("Quote Sheet").Select 
ActiveCell.Offset(1, 0).Select 
Selection.PasteSpecial Paste:=xlPasteValues 
Application.Run ("Borders") 
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 14)).Select 
Application.Run ("Borders") 
'To insert formulas 
Range("B12").Select 
Cells.Find(What:="ADDERS", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate 
ActiveCell.Offset(1, 1).Select 
Application.Run ("Formulas") 
ActiveCell.Offset(0, 2).Select 
ActiveCell.FormulaR1C1 = "=VLOOKUP(""ADDERS"",C[-16]:C,17,FALSE)" 
Application.Run ("AutofillOptions") 

문제는 주로 자동 필터 섹션을 참조하십시오. 이러한 모든 기준을 필터링하지만 데이터베이스에 항목이 없으므로 모든 항목이 복사됩니다. 필터링 된 항목이없는 경우이 코드에서 벗어나이 코드를 변경하도록 지시하는 코드 또는 방법이 있습니까? 사용자 지정 항목을 추가하는 단추가 있기 때문에 추가 자 섹션을 만들려고합니다. 필터가없는 경우 모든 항목을 복사하지 않아도됩니다. 어떤 도움이라도 대단히 감사합니다.

Answer 1

Dim NoOfFilteredCells As Long 
With ActiveSheet.ListObjects("Database").Range 
    NoOfFilteredCells = .Count - .SpecialCells(xlCellTypeVisible).Count 
End With 

숨겨진 것이 있는지 알아야 할 경우에만 작동합니다. 그것이하고있는 일은 총 세포 양에서 보이는 세포의 양을 빼는 것입니다. 이것은 숨겨진 수를 알려줍니다.

Sub Sample() 
Dim NoOfFilteredCells As Long 


With Range("B12").End(xlDown).Offset(1, 0) 
    .Font.Bold = True 
    .Font.Underline = xlUnderlineStyleSingle 
    .FormulaR1C1 = "ADDERS" 
    .Offset(1, 15).FormulaR1C1 = "ADDERS" 
    .Offset(-1, -15).Select 
End With 
'To filter data 
With ActiveSheet.ListObjects("Database").Range 
    .AutoFilter Field:=5, Criteria1:="4600", Operator:=xlOr, Criteria2:="All" 
    .AutoFilter Field:=6, Criteria1:="Adder" 
    .AutoFilter Field:=7, Criteria1:=Array("6201", "6201 Elec", "6201 Eng", "6201 FS Rad", "6201 FS SW", "6201 Rad", "6201 SII", "6201 Train", "CH Elec", "CH Eng", "CH FS", "CH High", "CH SII", "CH Std", "CH SW", "CM", "CM Eng", "Coiler", "Elec", "Elec Eng", "Eng", "ES", "Fluids Eng", "FM", "FS Elec", "FS SII", "FS SW", "Launder", "MA", "MA FS", "MA SII", "MA Train", "ML", "PMDA", "PP High", "PP Low", "QS", "Selee", "Selee Eng", "SII", "STAS", "STAS FS", "Train"), Operator:=xlFilterValues 
    NoOfFilteredCells = .Count - .SpecialCells(xlCellTypeVisible).Count 
End With 

If NoOfFilteredCells > 0 Then 
    'To select correct data to copy 
    Application.Run ("SelectDataToCopy") 
    'To copy data 
    Sheets("Quote Sheet").Select 
    ActiveCell.Offset(1, 0).Select 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Application.Run ("Borders") 
    Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 14)).Select 
    Application.Run ("Borders") 
    'To insert formulas 
    Range("B12").Select 
    Cells.Find(What:="ADDERS", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate 
    ActiveCell.Offset(1, 1).Select 
    Application.Run ("Formulas") 
    ActiveCell.Offset(0, 2).Select 
    ActiveCell.FormulaR1C1 = "=VLOOKUP(""ADDERS"",C[-16]:C,17,FALSE)" 
    Application.Run ("AutofillOptions") 
Else: Exit Sub 
End If 

End Sub 

을하지만 실제로 필터링 된 행 수를 알 필요가 있다면 당신은 같은 과정을 수행 할 수 있지만, 분할 :

은 그럼 당신은

If NoOfFilteredCells > 0 Then 
    'Put the code that does what you want it to do IF there ARE hidden rows here 
Else: Exit Sub 
End If 

아마 이런 식으로 뭔가 같은 것을 사용할 수 있습니다 행수를 돌려 줄 수에 의한 셀의 수.

Dim lngNoOfFilteredRows As Long 
Dim lngNoOfColumns As Long 

With ActiveSheet.ListObjects("Database").Range 
    lngNoOfColumns = .Columns.Count 
    lngNoOfFilteredRows = (.Count/lngNoOfColumns - 1) - (.SpecialCells(xlCellTypeVisible).Count/lngNoOfColumns - 1) 
End With 

코드에서 마이너스 1은 헤더를 고려한 것입니다.