shinythemes - derretir/remodelar en Excel usando VBA?

tags$div shiny

Question

Actualmente me estoy adaptando a un nuevo trabajo en el que la mayoría del trabajo que comparto con colegas es a través de MS Excel. Estoy utilizando tablas dinámicas con frecuencia y, por lo tanto, necesito datos "apilados", precisamente la salida de la función melt() en el paquete reshape (reshape2) en R en la que he llegado a confiar para esto.

¿Alguien podría comenzar con una macro VBA para lograr esto, o ya existe una?

El esquema de la macro sería:

1. Seleccione un rango de celdas en un libro de Excel.
2. Iniciar macro "fundido".
3. La macro crearía una solicitud, "Ingrese el número de columnas de identificación", donde ingresaría el número que precede a las columnas de información de identificación. (para el código R de ejemplo debajo es 4).
4. Cree una nueva hoja de trabajo en el archivo de Excel titulado "fusión" que apilaría los datos, y cree una nueva columna titulada "variable" igual a los encabezados de columna de datos de la selección original.

En otras palabras, la salida se vería exactamente igual a la salida de simplemente ejecutar estas dos líneas en R:

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

Aquí hay un ejemplo:

# 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

Answer 1

Microsoft recientemente lanzó Power Query, un complemento de Excel que agrega muchas funciones y capacidades interesantes a la manipulación de datos desde Excel, incluido lo que está buscando.

La función real dentro del complemento se denomina "Unpivot Columns", que se explica en este artículo . Aquí está la esencia de esto:

1. Descargue e instale el complemento
2. Abre tu archivo de Excel / CSV
3. Seleccione la tabla / rango que desea fundir / remodelar
4. En la pestaña "Consulta de energía", haga clic en "Desde la tabla", que abrirá el "Editor de consultas"
5. Seleccione las columnas que desea fundir / remodelar (ctrl o shift-select, no arrastre)
6. En la pestaña "Transformar", haga clic en "Eliminar columnas" (también puede aplicar otras transformaciones aquí antes de volver a Excel)
7. En la pestaña "Inicio", haga clic en "Cerrar y cargar". Esto creará una nueva tabla / objeto de consulta en Excel con el resultado deseado.

Answer 2

Para cualquier persona que busque una manera visual de normalizar los datos de Excel, vea este video tutorial:

http://www.youtube.com/watch?v=xmqTN0X-AgY

Answer 3

Primero cree un formulario de usuario y asígnele el nombre Unpivot_Form con dos campos RefEdit: rng_id y value_id y un botón enviar / ir. También soy un usuario R y rng_id es el rango que contiene el id, mientras que value_id contiene el valor; ambos rango inclusive de cabecera.

Haz dos macro:

Sub unpivot()
Unpivot_Form.Show
End Sub

Otra macro está dentro del botón enviar / ir del campo:

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

¡Disfrutar!

Answer 4

Tengo dos publicaciones, con código utilizable y libro de trabajo descargable, sobre cómo hacer esto en Excel / VBA en mi blog:

http://yoursumbuddy.com/data-normalizer

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

Aquí está el código:

''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
''rows that will be repeated must be to the left,
''with the rows 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

Lo llamarías así:

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

Answer 5

o usar:

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