IT

VBA를 사용하여 Excel에서 용해/재형성?

itgroup 2023. 6. 12. 21:18
반응형

VBA를 사용하여 Excel에서 용해/재형성?

저는 현재 동료들과 공유하는 일의 대부분이 MS Excel을 통해 이루어지는 새로운 직업에 적응하고 있습니다.는 피벗 자주 에 "가 필요합니다. 정확하게는 "" 입니다.melt()에서 합니다.reshape(모양 변경2) 이것을 위해 의지하게 된 R의 패키지.

이를 위해 VBA 매크로를 시작할 수 있는 사람이 있습니까, 아니면 이미 존재합니까?

매크로의 개요는 다음과 같습니다.

  1. Excel 워크북에서 셀 범위를 선택합니다.
  2. "용융" 매크로를 시작합니다.
  3. 매크로는 "ID 열 수 입력"이라는 메시지를 생성하여 식별 정보의 앞에 있는 열 수를 입력합니다(아래의 R 코드는 4).
  4. 데이터를 쌓을 "melt"라는 제목의 Excel 파일에 새 워크시트를 만들고 원래 선택한 데이터 열 헤더와 동일한 "variable"이라는 제목의 새 열을 만듭니다.

즉, 출력은 R에서 이 두 줄을 단순히 실행했을 때의 출력과 완전히 동일하게 보입니다.

require(reshape)
melt(your.unstacked.dataframe, id.vars = 1:4)

다음은 예입니다.

# unstacked data
> df1
  Year Month Country  Sport No_wins No_losses High_score Total_games
2 2010     5     USA Soccer       4         3          5           9
3 2010     6     USA Soccer       5         3          4           8
4 2010     5     CAN Soccer       2         9          7          11
5 2010     6     CAN Soccer       4         8          4          13
6 2009     5     USA Soccer       8         1          4           9
7 2009     6     USA Soccer       0         0          3           2
8 2009     5     CAN Soccer       2         0          6           3
9 2009     6     CAN Soccer       3         0          8           3

# stacking the data
> require(reshape)
> melt(df1, id.vars=1:4)

  Year Month Country  Sport    variable value
1  2010     5     USA Soccer     No_wins     4
2  2010     6     USA Soccer     No_wins     5
3  2010     5     CAN Soccer     No_wins     2
4  2010     6     CAN Soccer     No_wins     4
5  2009     5     USA Soccer     No_wins     8
6  2009     6     USA Soccer     No_wins     0
7  2009     5     CAN Soccer     No_wins     2
8  2009     6     CAN Soccer     No_wins     3
9  2010     5     USA Soccer   No_losses     3
10 2010     6     USA Soccer   No_losses     3
11 2010     5     CAN Soccer   No_losses     9
12 2010     6     CAN Soccer   No_losses     8
13 2009     5     USA Soccer   No_losses     1
14 2009     6     USA Soccer   No_losses     0
15 2009     5     CAN Soccer   No_losses     0
16 2009     6     CAN Soccer   No_losses     0
17 2010     5     USA Soccer  High_score     5
18 2010     6     USA Soccer  High_score     4
19 2010     5     CAN Soccer  High_score     7
20 2010     6     CAN Soccer  High_score     4
21 2009     5     USA Soccer  High_score     4
22 2009     6     USA Soccer  High_score     3
23 2009     5     CAN Soccer  High_score     6
24 2009     6     CAN Soccer  High_score     8
25 2010     5     USA Soccer Total_games     9
26 2010     6     USA Soccer Total_games     8
27 2010     5     CAN Soccer Total_games    11
28 2010     6     CAN Soccer Total_games    13
29 2009     5     USA Soccer Total_games     9
30 2009     6     USA Soccer Total_games     2
31 2009     5     CAN Soccer Total_games     3
32 2009     6     CAN Soccer Total_games     3

제 블로그에는 엑셀/VBA에서 이 작업을 수행하는 것에 대한 두 개의 게시물이 있습니다. 사용 가능한 코드와 다운로드 가능한 워크북이 있습니다.

http://yoursumbuddy.com/data-normalizer

http://yoursumbuddy.com/data-normalizer-the-sql/

코드는 다음과 같습니다.

'Arguments
'List: The range to be normalized.
'RepeatingColsCount: The number of columns, starting with the leftmost,
'   whose headings remain the same.
'NormalizedColHeader: The column header for the rolled-up category.
'DataColHeader: The column header for the normalized data.
'NewWorkbook: Put the sheet with the data in a new workbook?
'
'NOTE: The data must be in a contiguous range and the
'columns that will be repeated must be to the left,
'with the columns to be normalized to the right.

Sub NormalizeList(List As Excel.Range, RepeatingColsCount As Long, _
    NormalizedColHeader As String, DataColHeader As String, _
    Optional NewWorkbook As Boolean = False)

Dim FirstNormalizingCol As Long, NormalizingColsCount As Long
Dim ColsToRepeat As Excel.Range, ColsToNormalize As Excel.Range
Dim NormalizedRowsCount As Long
Dim RepeatingList() As String
Dim NormalizedList() As Variant
Dim ListIndex As Long, i As Long, j As Long
Dim wbSource As Excel.Workbook, wbTarget As Excel.Workbook
Dim wsTarget As Excel.Worksheet

With List
    'If the normalized list won't fit, you must quit.
   If .Rows.Count * (.Columns.Count - RepeatingColsCount) > .Parent.Rows.Count Then
        MsgBox "The normalized list will be too many rows.", _
               vbExclamation + vbOKOnly, "Sorry"
        Exit Sub
    End If

    'You have the range to be normalized and the count of leftmost rows to be repeated.
   'This section uses those arguments to set the two ranges to parse
   'and the two corresponding arrays to fill
   FirstNormalizingCol = RepeatingColsCount + 1
    NormalizingColsCount = .Columns.Count - RepeatingColsCount
    Set ColsToRepeat = .Cells(1).Resize(.Rows.Count, RepeatingColsCount)
    Set ColsToNormalize = .Cells(1, FirstNormalizingCol).Resize(.Rows.Count, NormalizingColsCount)
    NormalizedRowsCount = ColsToNormalize.Columns.Count * .Rows.Count
    ReDim RepeatingList(1 To NormalizedRowsCount, 1 To RepeatingColsCount)
    ReDim NormalizedList(1 To NormalizedRowsCount, 1 To 2)
End With

'Fill in every i elements of the repeating array with the repeating row labels.
For i = 1 To NormalizedRowsCount Step NormalizingColsCount
    ListIndex = ListIndex + 1
    For j = 1 To RepeatingColsCount
        RepeatingList(i, j) = List.Cells(ListIndex, j).Value2
    Next j
Next i

'We stepped over most rows above, so fill in other repeating array elements.
For i = 1 To NormalizedRowsCount
    For j = 1 To RepeatingColsCount
        If RepeatingList(i, j) = "" Then
            RepeatingList(i, j) = RepeatingList(i - 1, j)
        End If
    Next j
Next i

'Fill in each element of the first dimension of the normalizing array
'with the former column header (which is now another row label) and the data.
With ColsToNormalize
    For i = 1 To .Rows.Count
        For j = 1 To .Columns.Count
            NormalizedList(((i - 1) * NormalizingColsCount) + j, 1) = .Cells(1, j)
            NormalizedList(((i - 1) * NormalizingColsCount) + j, 2) = .Cells(i, j)
        Next j
    Next i
End With

'Put the normal data in the same workbook, or a new one.
If NewWorkbook Then
    Set wbTarget = Workbooks.Add
    Set wsTarget = wbTarget.Worksheets(1)
Else
    Set wbSource = List.Parent.Parent
    With wbSource.Worksheets
        Set wsTarget = .Add(after:=.Item(.Count))
    End With
End If

With wsTarget
    'Put the data from the two arrays in the new worksheet.
   .Range("A1").Resize(NormalizedRowsCount, RepeatingColsCount) = RepeatingList
    .Cells(1, FirstNormalizingCol).Resize(NormalizedRowsCount, 2) = NormalizedList

    'At this point there will be repeated header rows, so delete all but one.
   .Range("1:" & NormalizingColsCount - 1).EntireRow.Delete

    'Add the headers for the new label column and the data column.
   .Cells(1, FirstNormalizingCol).Value = NormalizedColHeader
    .Cells(1, FirstNormalizingCol + 1).Value = DataColHeader
End With
End Sub

당신은 이렇게 부를 것입니다.

Sub TestIt()
NormalizeList ActiveSheet.UsedRange, 4, "Variable", "Value", False
End Sub

마이크로소프트는 최근에 여러분이 찾고 있는 것을 포함하여 엑셀 내에서 데이터 조작에 많은 흥미로운 기능과 기능을 추가하는 엑셀 애드인인 파워 쿼리를 출시했습니다.

추가 기능 내의 실제 기능은 이 문서에서 설명하는 "Unpivot Columns"라고 합니다.요점은 다음과 같습니다.

  1. 추가 기능 다운로드 및 설치
  2. Excel/CSV 파일 열기
  3. 용해/재구성할 테이블/범위 선택
  4. "전원 쿼리" 탭에서 "테이블에서"를 클릭하면 "쿼리 편집기"가 열립니다.
  5. 용해/재형성할 열을 선택합니다(ctrl 또는 shift-select, 끌지 않음)
  6. 변환 탭에서 "열 분할 취소"를 클릭합니다(Excel로 돌아가기 전에 여기에 다른 변환을 적용할 수도 있습니다).
  7. "Home" 탭에서 "Close & Load"를 클릭합니다.원하는 결과를 가진 새 테이블/쿼리 개체가 Excel에 생성됩니다.

또는 사용:

Sub M_snb_000()
  With sheet1.Cells(1).CurrentRegion
    sn = .Resize(, .Columns.Count + 1)
  End With

  For j = 4 To UBound(sn, 2) - 1
    With Sheet2.Cells(2 + (UBound(sn) - 1) * (j - 4), 1)
       .Resize(UBound(sn) - 1, 5) = Application.Index(sn, Evaluate("row(2:" 
             & UBound(sn) & ")"), Array(1, 2, 3,UBound(sn, 2), j))
       .Resize(UBound(sn) - 1, 1).Offset(, 3) = sn(1, j)
    End With
  Next
End Sub

먼저 사용자 양식을 만들고 두 개의 RefEdit 필드(rng_id 및 value_id)와 submit/go 버튼으로 이름을 Unpivot_Form으로 지정합니다.나도 R 사용자이며 rng_id는 id를 포함하는 범위이고 value_id는 값을 포함하는 범위입니다. 두 범위 모두 헤더를 포함합니다.

두 개의 매크로를 수행합니다.

Sub unpivot()
Unpivot_Form.Show
End Sub

필드의 제출/실행 버튼 내에 다른 매크로가 있습니다.

Private Sub submit_Click()
'Code to unpivot (convert wide to long for excel)

Dim rng_id, rng_id_header, val_id As Range
Dim colvar, emptyrow, col As Integer
Dim new_sheet As Worksheet

'Put val_id range into a range object
Set val_id = Range(value_id.Value)

'Determine the parameter for the value id range
'This is used for the looping later on
numrows = val_id.Rows.Count
numcols = val_id.Columns.Count

'Resize changes the "block" to the size defined by the row and column
'Offset moves the "block"
Set rng_id_header = Range(range_id.Value).Resize(1)
Set rng_id = Range(range_id.Value).Offset(1, 0).Resize(numrows - 1)

Set new_sheet = Worksheets.Add

'Set up the first column and first batch of id vars
new_sheet.Activate
Range("A65535").End(xlUp).Activate
rng_id_header.Copy ActiveCell
colvar = Range("XFD1").End(xlToLeft).Column + 1
Range("XFD1").End(xlToLeft).Offset(, 1).Value = "Variable"
Range("XFD1").End(xlToLeft).Offset(, 1).Value = "Value"

'Start populating the value ids
For col = 1 To numcols

  'populate var_id
  'determine last row
   emptyrow = Range("A65535").End(xlUp).Row + 1
   'no need to activate to source to copy
   rng_id.Copy new_sheet.Cells(emptyrow, 1)
  'copy the variable
  val_id.Offset(, col - 1).Resize(1, 1).Copy new_sheet.Range(Cells(emptyrow, colvar), Cells(emptyrow + numrows - 2, colvar))
  'copy the value
  val_id.Offset(1, col - 1).Resize(numrows - 1, 1).Copy new_sheet.Range(Cells(emptyrow, colvar + 1), Cells(emptyrow + numrows - 2, colvar + 1))

Next

Unload Me

End Sub

맛있게 드세요!

언급URL : https://stackoverflow.com/questions/10921791/melt-reshape-in-excel-using-vba

반응형

'IT' 카테고리의 다른 글

판다 데이터 프레임에서 모든 0이 있는 행 삭제  (0) 2023.06.12
printf의 일부 텍스트를 녹색과 빨간색으로 표시  (0) 2023.06.12
Oracle REPLACE() 함수가 캐리지 리턴 및 라인 피드를 처리하지 않습니다.  (0) 2023.06.12
iOS 6의 레이블 정렬 - UI 텍스트 정렬 사용 안 함  (0) 2023.06.12
NSDateFormatter 로케일 "기능"을 처리하는 가장 좋은 방법은 무엇입니까?  (0) 2023.06.12

'IT'의 다른글

  • 현재글VBA를 사용하여 Excel에서 용해/재형성?

관련글

댓글

티스토리툴바