엑셀 열을 행으로 변환

Question

나는 큰 엑셀 시트 (대략 150 열 x 7000 행과 매일 증가 함)가 있지만 더 좋은 방법으로 정보를 추출해야합니다. 데이터베이스 소프트웨어에 액세스 할 수 없으며 Excel 만 사용할 수 있습니다. 정상적인 공식을 사용하여 원하는 결과를 얻지 못했지만 파일 크기가 거의 100mB (원래 4mB에서 증가)이며 작동하지 않습니다. 너무 느립니다. 문제를 부분적으로 만 해결하는 피벗 테이블을 만들었습니다. 저는 VBA를 처음 접했으므로 여기서 배우기 위해 몇 가지 예제를 시도했지만 그 중 대부분은 지금 저에게 너무 복잡합니다. 이론 상으로는 "Convert row with columns of data into column with multiple rows in Excel"이 내 문제를 부분적으로 해결하는 것처럼 보이지만 실행할 수 없습니다. 모듈에서 코드를 볼 수는 있지만 실행 버튼을 누르면 매크로 목록에 나타나지 않습니다.

Name1 Name2 Location No.   Type  
Fred Jones England  Subject1 Spanish 
Fred Jones England  Subject2 Maths 
Fred Jones England  Subject3 English 
Peter Brown Germany  Subject1 English 
Peter Brown Germany  Subject3 Maths 
Erik Strong Sweden  Subject1 Chemistry 
Erik Strong Sweden  Subject2 English 
Erik Strong Sweden  Subject3 Biology 

수있는 사람의 도움을하시기 바랍니다 - 여기 내가

Name1 Name2 Location Subject1 Subject2 Subject3 
Fred Jones England  Spanish  Maths  English 
Peter Brown Germany  English  (empty)  Maths 
Erik Strong Sweden  Chemistry English  Biology 

필수 결과 뿐인데 시작하고 무엇인가? 고맙습니다!

Answer 1

VBA를 포함하거나 포함하지 않는 전치 함수를 사용할 수 있습니다. 여기에 그냥 함께 던진 코드는 다음과 같습니다

Sub test() 
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row 
lastColumn = ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Column 
Dim rng As Range 
With Sheets("Sheet2")     ' the destination sheet 
Set rng = .Range(.Cells(1, 1), .Cells(lastColumn, lastRow)) 
End With 
rng.Value = _ 
Application.Transpose(ActiveSheet.Range(Cells(1, 1), Cells(lastRow, lastColumn))) 
End Sub 

Answer 2

는 내가 정기적으로 사용하는 스크립트를 공유하고자합니다. 모든 트랜잭션, 이벤트 등을 별도의 행에 넣고 싶을 때 단일 행에 여러 트랜잭션, 이벤트 등이있을 때 사용하십시오. 동일한 데이터 유형 (예 : Subject1, Subject2, Subject3 ...)을 포함하는 열을 가져 와서 여러 행에 걸쳐 하나의 열 (예 : Subject)으로 결합해야합니다. 다음과 같습니다

즉

, 데이터 :

Name Location Subject1 Subject2 Subject3 

는 다음과 같이 뜻 :

Name Location Subject1 
Name Location Subject2 
Name Location Subject3 

이 스크립트는 고정 컬럼 (들)이 왼쪽과에 있다고 가정 결합 할 열 (및 여러 행으로 분리)은 오른쪽에 있습니다. 이게 도움이 되길 바란다!

Option Explicit 

Sub MatrixConverter2_2() 

' Macro created 11/16/2005 by Peter T Oboyski (updated 8/24/2006) 
' 
' *** Substantial changes made by Chris Brackett (updated 8/3/2016) *** 
' 
' You are welcome to redistribute this macro, but if you make substantial 
' changes to it, please indicate so in this section along with your name. 
' This Macro converts matrix-type spreadsheets (eg. plot x species data) into column data 
' The new (converted) spreadsheet name is "DB of 'name of active spreadsheet'" 
' The conversion allows for multiple header rows and columns. 

'-------------------------------------------------- 
' This section declares variables for use in the script 

Dim book, head, cels, mtrx, dbase, v, UserReady, columnsToCombine, RowName, DefaultRowName, DefaultColName1, DefaultColName2, ColName As String 
Dim defaultHeaderRows, defaultHeaderColumns, c, r, selectionCols, ro, col, newro, newcol, rotot, coltot, all, rowz, colz, tot As Long 
Dim headers(100) As Variant 
Dim dun As Boolean 


'-------------------------------------------------- 
' This section sets the script defaults 

defaultHeaderRows = 1 
defaultHeaderColumns = 2 

DefaultRowName = "Activity" 

'-------------------------------------------------- 
' This section asks about data types, row headers, and column headers 

UserReady = MsgBox("Have you selected the entire data set (not the column headers) to be converted?", vbYesNoCancel) 
If UserReady = vbNo Or UserReady = vbCancel Then GoTo EndMatrixMacro 

all = MsgBox("Exclude zeros and empty cells?", vbYesNoCancel) 
If all = vbCancel Then GoTo EndMatrixMacro 


' UN-COMMENT THIS SECTION TO ALLOW FOR MULTIPLE HEADER ROWS 
rowz = 1 
' rowz = InputBox("How many HEADER ROWS?" & vbNewLine & vbNewLine & "(Usually 1)", "Header Rows & Columns", defaultHeaderRows) 
' If rowz = vbNullString Then GoTo EndMatrixMacro 

colz = InputBox("How many HEADER COLUMNS?" & vbNewLine & vbNewLine & "(These are the columns on the left side of your data set to preserve as is.)", "Header Rows & Columns", defaultHeaderColumns) 
If colz = vbNullString Then GoTo EndMatrixMacro 


'-------------------------------------------------- 
' This section allows the user to provide field (column) names for the new spreadsheet 

selectionCols = Selection.Columns.Count ' get the number of columns in the selection 
For r = 1 To selectionCols 
    headers(r) = Selection.Cells(1, r).Offset(rowOffset:=-1, columnOffset:=0).Value ' save the column headers to use as defaults for user provided names 
Next r 

colz = colz * 1 
columnsToCombine = "'" & Selection.Cells(1, colz + 1).Offset(rowOffset:=-1, columnOffset:=0).Value & "' to '" & Selection.Cells(1, selectionCols).Offset(rowOffset:=-1, columnOffset:=0).Value & "'" 

Dim Arr(20) As Variant 
newcol = 1 
For r = 1 To rowz 
    If r = 1 Then RowName = DefaultRowName 
    Arr(newcol) = InputBox("Field name for the fields/columns to be combined" & vbNewLine & vbNewLine & columnsToCombine, , RowName) 
    If Arr(newcol) = vbNullString Then GoTo EndMatrixMacro 
    newcol = newcol + 1 
Next 
For c = 1 To colz 
    ColName = headers(c) 
    Arr(newcol) = InputBox("Field name for column " & c, , ColName) 
    If Arr(newcol) = vbNullString Then GoTo EndMatrixMacro 
    newcol = newcol + 1 
Next 
Arr(newcol) = "Data" 
v = newcol 

'-------------------------------------------------- 
' This section creates the new spreadsheet, names it, and color codes the new worksheet tab 

mtrx = ActiveSheet.Name 
Sheets.Add After:=ActiveSheet 
dbase = "DB of " & mtrx 

'-------------------------------------------------- 
' If the proposed worksheet name is longer than 28 characters, truncate it to 29 characters. 
    If Len(dbase) > 28 Then dbase = Left(dbase, 28) 


'-------------------------------------------------- 
' This section checks if the proposed worksheet name 
' already exists and appends adds a sequential number 
' to the name 
    Dim sheetExists As Variant 
    Dim Sheet As Worksheet 
    Dim iName As Integer 

    Dim dbaseOld As String 
    dbaseOld = dbase ' save the original proposed name of the new worksheet 

    iName = 0 

    sheetExists = False 
CheckWorksheetNames: 

    For Each Sheet In Worksheets ' loop through every worksheet in the workbook 
     If dbase = Sheet.Name Then 
      sheetExists = True 
      iName = iName + 1 
      dbase = Left(dbase, Len(dbase) - 1) & " " & iName 
      GoTo CheckWorksheetNames 
      ' Exit For 
     End If 
    Next Sheet 


'-------------------------------------------------- 
' This section notify the user if the proposed 
' worksheet name is already being used and the new 
' worksheet was given an alternate name 

    If sheetExists = True Then 
     MsgBox "The worksheet '" & dbaseOld & "' already exists. Renaming to '" & dbase & "'." 
    End If 


'-------------------------------------------------- 
' This section creates and names a new worksheet 
    On Error Resume Next 'Ignore errors 
     If Sheets("" & Range(dbase) & "") Is Nothing Then ' If the worksheet name doesn't exist 
      ActiveSheet.Name = dbase ' Rename newly created worksheet 
     Else 
      MsgBox "Cannot name the worksheet '" & dbase & "'. A worksheet with that name already exists." 
      GoTo EndMatrixMacro 
     End If 
    On Error GoTo 0   ' Resume normal error handling 

    Sheets(dbase).Tab.ColorIndex = 41 ' color the worksheet tab 


'-------------------------------------------------- 
' This section turns off screen and calculation updates so that the script 
' can run faster. Updates are turned back on at the end of the script. 
    Application.Calculation = xlCalculationManual 
    Application.ScreenUpdating = False 


'-------------------------------------------------- 
'This section determines how many rows and columns the matrix has 

dun = False 
rotot = rowz + 1 
Do 
    If (Sheets(mtrx).Cells(rotot, 1) > 0) Then 
     rotot = rotot + 1 
    Else 
     dun = True 
    End If 
Loop Until dun 
rotot = rotot - 1 

dun = False 
coltot = colz + 1 
Do 
    If (Sheets(mtrx).Cells(1, coltot) > 0) Then 
     coltot = coltot + 1 
    Else 
     dun = True 
    End If 
Loop Until dun 
coltot = coltot - 1 


'-------------------------------------------------- 
'This section writes the new field names to the new spreadsheet 

For newcol = 1 To v 
    Sheets(dbase).Cells(1, newcol) = Arr(newcol) 
Next 


'-------------------------------------------------- 
'This section actually does the conversion 

tot = 0 
newro = 2 
For col = (colz + 1) To coltot 
    For ro = (rowz + 1) To rotot 'the next line determines if data are nonzero 
     If ((Sheets(mtrx).Cells(ro, col) <> 0) Or (all <> 6)) Then 'DCB modified ">0" to be "<>0" to exclude blank and zero cells 
      tot = tot + 1 
      newcol = 1 
      For r = 1 To rowz   'the next line copies the row headers 
       Sheets(dbase).Cells(newro, newcol) = Sheets(mtrx).Cells(r, col) 
       newcol = newcol + 1 
      Next 
      For c = 1 To colz   'the next line copies the column headers 
       Sheets(dbase).Cells(newro, newcol) = Sheets(mtrx).Cells(ro, c) 
       newcol = newcol + 1 
      Next        'the next line copies the data 
      Sheets(dbase).Cells(newro, newcol) = Sheets(mtrx).Cells(ro, col) 
      newro = newro + 1 
     End If 
    Next 
Next 


'-------------------------------------------------- 
'This section displays a message box with information about the conversion 

book = "Original matrix = " & ActiveWorkbook.Name & ": " & mtrx & Chr(10) 
head = "Matrix with " & rowz & " row headers and " & colz & " column headers" & Chr(10) 
cels = tot & " cells of " & ((rotot - rowz) * (coltot - colz)) & " with data" 


'-------------------------------------------------- 
' This section turns screen and calculation updates back ON. 
    Application.Calculation = xlCalculationAutomatic 
    Application.ScreenUpdating = True 


MsgBox (book & head & cels) 


'-------------------------------------------------- 
' This is an end point for the macro 

EndMatrixMacro: 

End Sub