Dim lastrow As Long
    Dim lngE As Long
    Dim rngD As Range
    Dim i As Long
    
    
    Dim j As Long
    Dim Data As Long
    Dim xLastRow As Long
    
    
    Dim RealDataLastRow As Long

    Dim DeletedWantedRow As Long

    Dim LastLoopIndex As Long
    
    Dim co As Long
    Dim incRow As Long
    
    Dim k As Long
    Dim LastDateTime As Long
    
    
     Dim xWs As Worksheet


    lastrow = Sheets("20210421").Cells(Rows.Count, "F").End(xlUp).Row
    Sheets("20210421").Range("F2:F" & lastrow).AdvancedFilter _
        Action:=xlFilterCopy, _
        CopyToRange:=Sheets("Sheet1").Range("B5"), _
        Unique:=True
    'DIstinct Part
    
  

     'Dintct 된 데이터 갯수만큼의 전처리시트가 필요
    
    xLastRow = Sheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row - 4
    ' 6 제대로 나왔음 -> 데이터의 총 갯수
    
    
    For j = 1 To xLastRow
        ' 1 2 3 4 5 6
        
        lngE = Sheets("20210421").Cells(Rows.Count, "F").End(xlUp).Row
        
        For i = 2 To lngE
            If Sheets("20210421").Range("F" & i).Value = Sheets("Sheet1").Range("B" & (4 + j)).Value Then
                If rngD Is Nothing Then
                    Set rngD = Sheets("20210421").Range("F" & i).Offset(0, -5).Resize(1, 6)
                Else
                    Set rngD = Union(rngD, Sheets("20210421").Range("F" & i).Offset(0, -5).Resize(1, 6))
                End If
            End If
        Next
    
        If rngD Is Nothing Then
            MsgBox "복사할 범위가 없습니다."
        Else
            Sheets.Add after:=Sheets(2 + j)
            Sheets(3 + j).Range("A1").CurrentRegion.Offset(1, 0).Clear
            rngD.Copy Sheets(3 + j).Range("A1")
        End If
    
        '시트를 추가하고 데이터 사전 전처리
    
        co = Sheets(3 + j).Range("F1").CurrentRegion.Rows.Count
        
        For incRow = 0 To co
            If Sheets("Sheet1").Range("B" & (4 + j)).Value <> Sheets(3 + j).Cells(1, "F").Offset(0, 0).Value Then
            '시트와 데이터를 비교
                Sheets(3 + j).Range("F1").Select
                Selection.EntireRow.Delete
            End If
        Next
        
        '데이터 사전가공 완료
                     
    Next
    
    
    
    
    For k = 1 To xLastRow
    
        LastDateTime = Sheets(3 + k).Cells(Rows.Count, "B").End(xlUp).Row
    
        '모든 시트의 D1에는 데이터가 있음
        Sheets(3 + k).Activate
        Range("D1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        ' 카피부
        Sheets("Sheet1").Activate
        Cells(5, "E").Offset(k - 1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
            
        Sheets("Sheet1").Cells(4 + k, "C").Offset(0, 0).Value = Sheets(3 + k).Range("B1").Value
        Sheets("Sheet1").Cells(4 + k, "D").Offset(0, 0).Value = Sheets(3 + k).Range("B" & LastDateTime).Value
    Next
    
    
    
    '마무리 처리
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Sheet1" And xWs.Name <> "20210421" And xWs.Name <> "Sheet2" Then 'Sheet1 과 남길시트이름 두개만 남기고 모두 삭제됨
            xWs.Delete
        End If
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Sheets("Sheet1").Activate

'VBA' 카테고리의 다른 글

[VBA] Specific Data Distraction  (0) 2021.04.23
[VBA] last Data Cell Searching  (0) 2021.04.23
[VBA] Sheet.Add and Sheet.Delete Method  (0) 2021.04.23
[VBA] Specific Data Deleting  (0) 2021.04.23
Sheet Deleting except specific sheet  (0) 2021.04.23
Data Distraction and Data-analyzing-insertion  (0) 2021.04.23
블로그 이미지

remoted

Remoted's IT LAB & POST DATABASE

댓글을 달아 주세요