2012-02-08 5 views
0

네 개의 다른 섹션이있는 기존 책에서 새 워크 시트 ("끌어 오기")로 대량의 데이터를 SharePoint에서 가져옵니다. 실행될 매크로를 개발하려고합니다.) 자동으로 끌어 오기 필드에서 데이터를 필터링합니다. b) 셀 A5에서 시작하여 기존 시트에 필터링 된 데이터의 복사/"값 붙여 넣기"; c.) 다음 시트를 위해 풀에서 필터를 재설정하십시오.플랫 파일 채우기

예를 들어, 끌어 오기 (기본 워크 시트 이름 "owssvr")에서 각 행의 열에는 해당 행의 항목이 생성 된 시점을 나타내는 AR 날짜가 있습니다. 이전 달의 모든 항목을 자동으로 필터링 (또는 사용자에게 월 선택 옵션 제공)하고 필터링 된 결과의 값을 셀에서 시작하는 '월간 보고서'라는 워크 시트에 복사/붙여 넣기하려면 어떻게합니까? A5 (헤더가 변경되지 않도록 허용)? 이것이 가능한가?

답변

0

이것은 내가 그을 작성하는 방법입니다

Option Explicit 

Sub MonthFilter() 
Dim LR As Long, MyDate As Date, d1 As Date, d2 As Date 

MyDate = Application.InputBox("Enter any date in the month you wish to pull", "Enter Date", Date - 30, Type:=2) 
If MyDate = 0 Then 
    Exit Sub 
Else 
    d1 = DateSerial(Year(MyDate), Month(MyDate), 1) 
    d2 = DateSerial(Year(MyDate), Month(MyDate) + 1, 1) - 1 
End If 

With Sheets("The Pull") 
    .AutoFilterMode = False 
    .Rows(1).AutoFilter 
    .Rows(1).AutoFilter 44, Criteria1:=">=" & d1, _ 
      Operator:=xlAnd, Criteria2:="<=" & d2 
    LR = .Cells(.Rows.Count, 44).End(xlUp).Row 
    If LR > 1 Then .Range("A2:A" & LR).EntireRow.Copy Sheets("Monthly Report").Range("A5") 
    .AutoFilterMode = False 
End With 

End Sub 
0

당신은 AutoFilterShowAllData가 필터링으로 필터링 할 수 있습니다. 다음은 그 예입니다.

Sub CopyLastMonthFromThePull(shtCopyTo As Worksheet) 
    Dim rngPullTable As Range, iColumnToFilter As Integer, strMonth As String 

    ' this assumes that the pull data is the first Excel Table on ThePull worksheet named owssvr 
    Set rngPullTable = ThisWorkbook.Worksheets("owssvr").ListObjects(1).Range 
    rngPullTable.Parent.Activate 

    ' determine the filter details 
    strMonth = CStr(DateSerial(Year(Date), Month(Date) - 1, Day(Date))) ' one month prior to today 
    iColumnToFilter = 44 ' Column AR is the 44th column 

    ' filter the table 
    rngPullTable.AutoFilter Field:=iColumnToFilter, Operator:=xlFilterValues _ 
        , Criteria2:=Array(1, strMonth) 
    DoEvents 

    ' copy the filtered results. (This also copies the header row.) 
    rngPullTable.Copy 
    With shtCopyTo 
     .Activate 
     .Range("A5").PasteSpecial xlPasteFormulasAndNumberFormats 
     .Columns.AutoFit 
     .Range("A1").Select 
    End With 
    Application.CutCopyMode = False 

    ' remove filter 
    With rngPullTable.Parent 
     .Activate 
     .ShowAllData 
    End With 
    rngPullTable.Range("A1").Select 

    ' End with the sheet being copied to active 
    shtCopyTo.Activate 

End Sub