Macro de Excel para automatizar el análisis de datos de dinámica molecular.


Necesitamos un fichero *.xlxm habilitado para ejecutar macros cuya primera pestaña sea "RMSD", segunda "DeltaG" y tercera "template".Los datos se encuentran desde B3:B2003.


La pestaña "template" tiene los gráficos y configuraciones iniciales que se utilizarán para clonar y personalizar los nuevos gráficos.


Sub ClonarTemplate_VersionFinal_Perfecta()
    Dim wb As Workbook
    Dim wsRMSD As Worksheet, wsDG As Worksheet, wsTemplate As Worksheet, wsNew As Worksheet
    Dim lastCol As Long, lastRowRMSD As Long, lastRowDG As Long
    Dim i As Long, j As Long, grupoIdx As Long
    Dim colIdx As Long, groupSize As Long
    Dim chRMSD As Chart, chDG As Chart
    Dim fullColName As String, labelName As String
    Dim colLetra As String
    
    Dim fY_RMSD As String, fY_DG As String
    
    ' Paleta de colores RGB de la plantilla (Rojo, Amarillo, Verde, Cian, Morado)
    Dim colores(1 To 5) As Long
    colores(1) = RGB(218, 31, 40)   ' Rojo
    colores(2) = RGB(244, 190, 16)  ' Amarillo / Oro
    colores(3) = RGB(35, 161, 88)   ' Verde
    colores(4) = RGB(0, 178, 238)   ' Cian / Azul claro
    colores(5) = RGB(112, 48, 160)  ' Morado
    
    ' Optimización de velocidad en el entorno Excel
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set wb = ThisWorkbook
    Set wsRMSD = wb.Sheets("RMSD")
    Set wsDG = wb.Sheets("DeltaG")
    Set wsTemplate = wb.Sheets("template")
    
    ' Medición de las dimensiones reales de los datos
    lastRowRMSD = wsRMSD.Cells(wsRMSD.Rows.Count, 1).End(xlUp).Row
    lastRowDG = wsDG.Cells(wsDG.Rows.Count, 1).End(xlUp).Row
    lastCol = wsRMSD.Cells(1, wsRMSD.Columns.Count).End(xlToLeft).Column
    
    groupSize = 5
    grupoIdx = 1
    
    ' Segmentación en bloques de 5 columnas (comenzando en la columna 2, la columna 1 tiene el tiempo.)
    For i = 2 To lastCol Step groupSize
        
        ' 1. Clonación exacta de la pestaña molde
        wsTemplate.Copy After:=wb.Sheets(wb.Sheets.Count)
        Set wsNew = wb.Sheets(wb.Sheets.Count)
        wsNew.Name = "Grupo_" & grupoIdx
        
        ' Vinculación de los gráficos de la nueva hoja
        Set chRMSD = wsNew.ChartObjects(1).Chart
        Set chDG = wsNew.ChartObjects(2).Chart
        
        ' Eliminación definitiva de títulos superpuestos dentro del gráfico
        chRMSD.HasTitle = False
        chDG.HasTitle = False
        
        ' =============================================================
        ' 2. PROCESAMIENTO DE DATOS, COLORES Y ESTADÍSTICAS
        ' =============================================================
        For j = 0 To groupSize - 1
            colIdx = i + j
            
            If colIdx <= lastCol Then
                ' Extracción limpia del identificador del compuesto (Molport)
                fullColName = wsRMSD.Cells(1, colIdx).Value
                If InStr(fullColName, "Molport-") > 0 Then
                    labelName = Mid(fullColName, InStr(fullColName, "Molport-"))
                Else
                    labelName = fullColName
                End If
                
                ' Traducir índice numérico a coordenadas de letra de Excel
                colLetra = Split(wsRMSD.Cells(1, colIdx).Address, "$")(1)
                
                ' Mapeo estricto iniciando en la fila $3
                fY_RMSD = "='" & wsRMSD.Name & "'!$" & colLetra & "$3:$" & colLetra & "$" & lastRowRMSD
                fY_DG = "='" & wsDG.Name & "'!$" & colLetra & "$3:$" & colLetra & "$" & lastRowDG
                
                ' --- AJUSTES GRÁFICO 1: RMSD (Líneas) ---
                With chRMSD.SeriesCollection(j + 1)
                    .Values = fY_RMSD
                    .Name = labelName
                    .Format.Line.ForeColor.RGB = colores(j + 1)
                End With
                
                ' --- AJUSTES GRÁFICO 2: DeltaG (Dispersión de puntos) ---
                With chDG.SeriesCollection(j + 1)
                    .Values = fY_DG
                    .Name = labelName
                    .MarkerBackgroundColor = colores(j + 1)
                    .MarkerForegroundColor = colores(j + 1)
                End With
                
                ' --- VINCULACIÓN DE TABLA ESTADÍSTICA (Columnas O, P, Q) ---
                ' Celda O: Nombre dinámico de la fila 2 de la simulación
                wsNew.Cells(j + 2, "O").FormulaLocal = "=RMSD!" & colLetra & "$2"
                
                ' Celda P: Cálculo de promedio matemático (Fila 3 en adelante)
                wsNew.Cells(j + 2, "P").FormulaLocal = _
                    "=PROMEDIO(DeltaG!" & colLetra & "$3:$" & _
                    colLetra & "$" & lastRowDG & ")"
                
                ' Celda Q: Cálculo de desviación estándar (Fila 3 en adelante)
                wsNew.Cells(j + 2, "Q").FormulaLocal = _
                    "=DESVEST(DeltaG!" & colLetra & "$3:$" & _
                    colLetra & "$" & lastRowDG & ")"                
            Else
                ' Gestión cuando el último bloque cuenta con menos de 5 elementos
                If chRMSD.SeriesCollection.Count >= (j + 1) Then chRMSD.SeriesCollection(j + 1).Delete
                If chDG.SeriesCollection.Count >= (j + 1) Then chDG.SeriesCollection(j + 1).Delete
                
                ' Limpieza física de las celdas sobrantes
                wsNew.Cells(j + 2, "O").Value = ""
                wsNew.Cells(j + 2, "P").Value = ""
                wsNew.Cells(j + 2, "Q").Value = ""
            End If
        Next j
        
        grupoIdx = grupoIdx + 1
    Next i
    
    ' Devolución del control operacional a Excel
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "¡Proyecto terminado!" & vbCrLf & _
           "- Rangos ajustados desde la fila 3 de forma limpia." & vbCrLf & _
           "- Gráficos escalados, sin títulos y con colores iguales." & vbCrLf & _
           "- Mapeo estadístico (Mean & SD) sincronizado al 100%.", vbInformation, "Fin del Proceso"
End Sub