☰

날짜 열을 기준으로 하나의 Excel 워크시트를 여러 파일로 분할하려면 어떻게 해야 합니까?

tag-icon • tag-icon microsoft-excel vba macros
날짜 열을 기준으로 하나의 Excel 워크시트를 여러 파일로 분할하려면 어떻게 해야 합니까?

10,000개의 행이 있는 워크시트를 D열의 날짜를 기준으로 여러 Excel 파일로 분할해야 합니다. 파일에는 9개의 열(A:I)이 있습니다. D열의 날짜는 현재 DD/MM/YYYY 형식으로 되어 있습니다. 파일 수를 줄이기 위해 파일을 MMM/YYYY로만 분할하고 싶습니다. 지금까지의 코드는 다음과 같습니다. 워크시트를 여러 파일로 분할했지만 파일을 열면 관련 월 및 연도에 대한 데이터가 아닌 헤더만 복사되었습니다.

D열의 MMM/YYYY와 관련된 모든 데이터를 어떻게 복사하여 붙여넣고 모든 분할 파일을 이와 같은 특정 폴더에 저장하려면 어떻게 해야 합니까? C:\일반\런던\클라이언트

Sub SplitData()
'
' SplitData Macro

Dim objWorksheet As Excel.Worksheet
Dim nLastRow, nRow, nNextRow As Integer
Dim strColumnValue As String
Dim objDictionary As Object
Dim varColumnValues As Variant
Dim varColumnValue As Variant
Dim objExcelWorkbook As Excel.Workbook
Dim objSheet As Excel.Worksheet

Dim aCol As String
aCol = "D"

On Error GoTo err1

 With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
 End With

Set objWorksheet = ActiveSheet
nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row

Set objDictionary = CreateObject("Scripting.Dictionary")

 For nRow = 1 To nLastRow

    strColumnValue = Format(objWorksheet.Range(aCol & nRow).Value, "Report_mmm_yyyy")

    If objDictionary.Exists(strColumnValue) = False Then
       objDictionary.Add strColumnValue, 1
    End If
Next

varColumnValues = objDictionary.Keys

For i = LBound(varColumnValues) To UBound(varColumnValues)
    varColumnValue = varColumnValues(i)


    Set objExcelWorkbook = Excel.Application.Workbooks.Add

    Set objSheet = objExcelWorkbook.Sheets(1)
    objSheet.Name = objWorksheet.Name

    objWorksheet.Rows(1).EntireRow.Copy
    objSheet.Activate
    objSheet.Range("A1").Select
    objSheet.Paste

     For nRow = 1 To nLastRow
        If CStr(objWorksheet.Range(aCol & nRow).Value) = CStr(varColumnValue) Then

           objWorksheet.Rows(nRow).EntireRow.Copy

           nNextRow = objSheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row + 1
           objSheet.Range("A" & nNextRow).Select
           objSheet.Paste
           objSheet.Columns("A:I").AutoFit
        End If
    Next
    objExcelWorkbook.SaveAs (CStr(varColumnValue))
Next

err1:
     With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
     End With

End Sub

답변1

가장 중요한 것은 교체였습니다.

If CStr(objWorksheet.Range(aCol & nRow).Value) = CStr(varColumnValue) Then

~와 함께

If Format(objWorksheet.Range(aCol & nRow).Value, "Report_mmm_yyyy") = varColumnValue Then

하지만 복사-붙여넣기를 좀 더 빠르게 하기 위해 더 많은 변경을 했습니다. 참고로, 붙여넣기는 빠른 옵션이 아닙니다. 다음과 같은 작업을 수행할 수 있습니다 TargetCell.Value = SourceCell.Value(이 경우 값만 전송됩니다).

Sub SplitData()
  '
  ' SplitData Macro

  Dim objWorksheet As Excel.Worksheet
  Dim nLastRow As Integer, nRow As Integer, nNextRow As Integer
  Dim strColumnValue As String
  Dim objDictionary As Object
  Dim varColumnValues As Variant
  Dim varColumnValue As Variant
  Dim objExcelWorkbook As Excel.Workbook
  Dim objSheet As Excel.Worksheet
  Dim i As Long

  Dim aCol As String
  aCol = "D"

  On Error GoTo err1

  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
  End With

  Set objWorksheet = ActiveSheet
  nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row

  Set objDictionary = CreateObject("Scripting.Dictionary")

  For nRow = 2 To nLastRow

    strColumnValue = Format(objWorksheet.Range(aCol & nRow).Value, "Report_mmm_yyyy")

    If objDictionary.Exists(strColumnValue) = False Then
      objDictionary.Add strColumnValue, 1
    End If
  Next

  varColumnValues = objDictionary.Keys

  For i = LBound(varColumnValues) To UBound(varColumnValues)
    varColumnValue = varColumnValues(i)

    Set objExcelWorkbook = Excel.Application.Workbooks.Add

    Set objSheet = objExcelWorkbook.Sheets(1)
    objSheet.Name = objWorksheet.Name

    objSheet.Rows(1).Value = objWorksheet.Rows(1).Value
    objWorksheet.Rows(1).Copy objSheet.Rows(1)

    nNextRow = 2
    For nRow = 1 To nLastRow
      If Format(objWorksheet.Range(aCol & nRow).Value, "Report_mmm_yyyy") = varColumnValue Then
        objWorksheet.Rows(nRow).Copy objSheet.Rows(nNextRow)
        nNextRow = nNextRow + 1
      End If
    Next
    objSheet.Columns("A:I").AutoFit
    ' Closing the workbook with changes saved
    objExcelWorkbook.Close True, CStr(varColumnValue)

  Next

err1:
  With Application
   .ScreenUpdating = True
   .Calculation = xlCalculationAutomatic
   .EnableEvents = True
  End With

End Sub

답변2

하위 SplitData() ' ' SplitData 매크로

Dim objWorksheet As Excel.Worksheet Dim nLastRow As Integer, nRow As Integer, nNextRow As Integer Dim strColumnValue As String Dim objDictionary As Object Dim varColumnValues ​​As Variant Dim varColumnValue As Variant Dim objExcelWorkbook As Excel.Workbook Dim objSheet As Excel.Worksheet Dim i As Long Dim FPath As String FPath = Application.ActiveWorkbook.Path

Dim aCol As String aCol = "A"

오류 발생 시 GoTo err1

응용 프로그램 사용 .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False 끝

설정 objWorksheet = ActiveSheet nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row

objDictionary = CreateObject("Scripting.Dictionary") 설정

nRow = 2의 경우 nLastRow로

strColumnValue = Format(objWorksheet.Range(aCol & nRow).Value, "mmm_yyyy")

If objDictionary.Exists(strColumnValue) = False Then
  objDictionary.Add strColumnValue, 1
End If

다음

varColumnValues ​​= objDictionary.Keys

i = LBound(varColumnValues)의 경우 UBound(varColumnValues) varColumnValue = varColumnValues(i)

Set objExcelWorkbook = Excel.Application.Workbooks.Add

Set objSheet = objExcelWorkbook.Sheets(1)
objSheet.Name = objWorksheet.Name

objSheet.Rows(1).Value = objWorksheet.Rows(1).Value
objWorksheet.Rows(1).Copy objSheet.Rows(1)

nNextRow = 2
For nRow = 1 To nLastRow
  If Format(objWorksheet.Range(aCol & nRow).Value, "mmm_yyyy") = varColumnValue Then
    objWorksheet.Rows(nRow).Copy objSheet.Rows(nNextRow)
    nNextRow = nNextRow + 1
  End If
Next
objSheet.Columns("A:K").AutoFit
CheckDir (FPath & "\" & varColumnValue)
objExcelWorkbook.SaveAs FPath & "\" & varColumnValue & "\" & "Report.xlsx"
' Closing the workbook with changes saved
objExcelWorkbook.Close True, CStr(varColumnValue)

다음

err1: 응용 프로그램 포함 .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableEvents = True 끝

서브 끝

함수 CheckDir(경로를 문자열로)

If Dir(Path, vbDirectory) = "" Then
    MkDir (Path)
End If

기능 종료

관련 정보