Attribute VB_Name = "modReestructurarConMapeo"
Option Explicit

' =====================================================================
'  modReestructurarConMapeo - Convertir una hoja a otra estructura de
'  columnas siguiendo una hoja de MAPEO, con busquedas en tablas maestras
'  y cruces con otras hojas. Sin tocar el codigo: cambiar el mapeo cambia
'  la conversion.
'
'  QUE HACE
'    Caso tipico: te llega un fichero con una estructura (un ERP, un
'    proveedor, un portal) y tienes que entregarlo con otra (una plantilla
'    oficial, otro sistema), traduciendo codigos a descripciones por medio
'    de tablas y completando columnas desde otras hojas. La salida se
'    escribe en un libro NUEVO (.xlsx con fecha y hora) junto al original.
'
'  COMO USARLA
'    1. Importa modUtilidades.bas y este modulo (Alt+F11 > Importar).
'       Guarda el libro como .xlsm (la salida se crea en su misma carpeta).
'    2. Crea la hoja "Mapeo" (una fila por columna de salida, ver abajo)
'       y la hoja "Config" con HojaBase.
'    3. Ejecuta ReestructurarConMapeo (Alt+F8).
'
'  PARA ADAPTARLA  (busca ">> ADAPTAR")
'    - Anadir una operacion nueva (p. ej. FECHA, MAYUSCULAS, CONCATENAR).
'    - Escribir la salida en el mismo libro en vez de en uno nuevo.
'    - Cambiar el nombre o la carpeta del archivo de salida.
'
'  Hoja "Config":
'    HojaBase       Hoja cuyas filas producen la salida (una fila por fila)
'    HojaMapeo      Nombre de la hoja de mapeo (Mapeo)
'    NombreSalida   Nombre de la hoja de salida en el libro nuevo (Salida)
'    CopiarMaestros SI para copiar las hojas maestras al libro de salida
'
'  Hoja "Mapeo" (una fila por columna de salida; la fila 1 es cabecera):
'    A ColumnaSalida   Columna de la hoja de salida (ej. C o AA)
'    B Cabecera        Texto de cabecera en la salida
'    C Operacion       COPIAR | BUSCAR | CRUZAR | SI_NO | FIJO
'    D Origen          COPIAR/SI_NO/BUSCAR: columna(s) de HojaBase ("C" o "C|D")
'                      CRUZAR: columna(s) de HojaBase con la clave ("A")
'                      FIJO: el texto fijo
'    E Hoja            BUSCAR: hoja maestra. CRUZAR: hoja a cruzar
'    F ColumnasClave   BUSCAR/CRUZAR: columna(s) clave en esa hoja ("A|B")
'    G ColumnaValor    BUSCAR/CRUZAR: columna con el valor a traer
'    H SiNoEncontrado  Texto si la clave no existe (vacio = "NO DEFINIDO (clave)")
'
'  Operaciones:
'    COPIAR  copia el valor de la columna de origen (recortado)
'    BUSCAR  forma la clave con las columnas de Origen y la busca en la
'            hoja maestra (ColumnasClave) devolviendo ColumnaValor
'    CRUZAR  igual que BUSCAR pero pensado para hojas de datos: trae la
'            primera coincidencia (equivale a un BUSCARV con varias claves)
'    SI_NO   S/N (o SI/NO, Y/N, 1/0, VERDADERO/FALSO) -> "Si" / "No"
'    FIJO    escribe el texto de Origen en todas las filas
'  Requiere: modUtilidades.
' =====================================================================

Private Type Regla
    ColSalida As Long
    Cabecera As String
    Operacion As String
    Origen As String
    ColsOrigen() As Long
    Hoja As String
    Dict As Object
    SiNoEncontrado As String
End Type

Public Sub ReestructurarConMapeo()
    Dim wsBase As Worksheet, wsMapeo As Worksheet, wbOut As Workbook, wsOut As Worksheet, est As EstadoExcel
    Dim reglas() As Regla, nReglas As Long, i As Long, j As Long, ultBase As Long, maxColBase As Long, maxColOut As Long
    Dim base As Variant, salida() As Variant, k As String, v As Variant, ruta As String, t As Double, cabeceras() As Variant
    Dim cachesMaestros As Object, claveCache As String

    On Error GoTo Fallo
    t = CDbl(Timer)
    If Len(ThisWorkbook.Path) = 0 Then Err.Raise vbObjectError + 503, , "Guarda el libro antes de reestructurar."
    Set wsBase = Hoja(LeerConfig("HojaBase"))
    Set wsMapeo = Hoja(LeerConfig("HojaMapeo", False, "Mapeo"))

    GuardarEstado est
    Application.StatusBar = "Leyendo el mapeo..."
    Set cachesMaestros = CreateObject("Scripting.Dictionary")
    nReglas = LeerReglas(wsMapeo, reglas, cachesMaestros)

    ultBase = UltimaFila(wsBase, 1)
    If ultBase < 2 Then Err.Raise vbObjectError + 502, , "La hoja base no tiene filas de datos."
    For i = 1 To nReglas
        For j = LBound(reglas(i).ColsOrigen) To UBound(reglas(i).ColsOrigen)
            If reglas(i).ColsOrigen(j) > maxColBase Then maxColBase = reglas(i).ColsOrigen(j)
        Next j
        If reglas(i).ColSalida > maxColOut Then maxColOut = reglas(i).ColSalida
    Next i
    If maxColBase < 2 Then maxColBase = 2 ' asi .Value devuelve siempre un array 2D
    base = wsBase.Range(wsBase.Cells(2, 1), wsBase.Cells(ultBase, maxColBase)).Value

    Application.StatusBar = "Construyendo la salida..."
    ReDim salida(1 To UBound(base, 1), 1 To maxColOut)
    ReDim cabeceras(1 To 1, 1 To maxColOut)
    For i = 1 To nReglas
        cabeceras(1, reglas(i).ColSalida) = reglas(i).Cabecera
    Next i
    For i = 1 To UBound(base, 1)
        For j = 1 To nReglas
            Select Case reglas(j).Operacion
                Case "COPIAR"
                    salida(i, reglas(j).ColSalida) = Valor(base(i, reglas(j).ColsOrigen(0)))
                Case "SI_NO"
                    salida(i, reglas(j).ColSalida) = SiNo(base(i, reglas(j).ColsOrigen(0)))
                Case "FIJO"
                    salida(i, reglas(j).ColSalida) = reglas(j).Origen
                ' >> ADAPTAR: para una operacion nueva anade un Case aqui y otro en LeerReglas
                '    (para validar sus columnas). Ejemplos:
                '    Case "MAYUSCULAS": salida(i, reglas(j).ColSalida) = UCase$(Limpiar(base(i, reglas(j).ColsOrigen(0))))
                '    Case "CONCATENAR": salida(i, reglas(j).ColSalida) = Replace(ClaveDe(base, i, reglas(j).ColsOrigen), "|", " ")
                Case "BUSCAR", "CRUZAR"
                    k = ClaveDe(base, i, reglas(j).ColsOrigen)
                    If Len(Replace(k, "|", "")) = 0 Then
                        salida(i, reglas(j).ColSalida) = ""
                    ElseIf reglas(j).Dict.Exists(k) Then
                        salida(i, reglas(j).ColSalida) = reglas(j).Dict(k)
                    ElseIf Len(reglas(j).SiNoEncontrado) > 0 Then
                        salida(i, reglas(j).ColSalida) = reglas(j).SiNoEncontrado
                    Else
                        salida(i, reglas(j).ColSalida) = "NO DEFINIDO (" & Replace(k, "|", "-") & ")"
                    End If
            End Select
        Next j
        If i Mod 500 = 0 Then Progreso "Filas", i, UBound(base, 1)
    Next i

    Application.StatusBar = "Escribiendo el libro de salida..."
    Set wbOut = Workbooks.Add(xlWBATWorksheet)
    Set wsOut = wbOut.Worksheets(1)
    wsOut.Name = LeerConfig("NombreSalida", False, "Salida")
    wsOut.Range("A1").Resize(1, maxColOut).Value = cabeceras
    wsOut.Range("A1").Resize(1, maxColOut).Font.Bold = True
    wsOut.Range("A2").Resize(UBound(salida, 1), maxColOut).Value = salida
    wsOut.Columns(1).Resize(, maxColOut).AutoFit
    If ConfigBool("CopiarMaestros", False) Then CopiarMaestros wbOut, reglas, nReglas

    ' >> ADAPTAR: nombre y carpeta del archivo de salida. Para escribir en el propio libro
    '    (sin crear uno nuevo) sustituye Workbooks.Add por ThisWorkbook.Worksheets.Add y quita el SaveAs.
    ruta = ThisWorkbook.Path & "\" & wsOut.Name & "_" & Format$(Now, "yyyymmdd_hhmmss") & ".xlsx"
    Application.DisplayAlerts = False
    wbOut.SaveAs Filename:=ruta, FileFormat:=51
    Application.DisplayAlerts = True
    wsOut.Activate
    wsOut.Range("A1").Select
    RestaurarEstado est
    Aviso UBound(salida, 1) & " filas reestructuradas en " & Format$(SegundosDesde(t), "0.0") & " s." & vbCrLf & "Archivo: " & ruta, vbInformation
    Exit Sub
Fallo:
    RestaurarEstado est
    Aviso "Error " & Err.Number & ": " & Err.Description, vbCritical
End Sub

' ---------- Mapeo ----------
Private Function LeerReglas(ByVal wsMapeo As Worksheet, ByRef reglas() As Regla, ByVal caches As Object) As Long
    Dim ult As Long, datos As Variant, i As Long, n As Long, op As String, claveCache As String
    ult = UltimaFila(wsMapeo, 1)
    If ult < 2 Then Err.Raise vbObjectError + 504, , "La hoja Mapeo esta vacia."
    datos = wsMapeo.Range("A2:H" & ult).Value
    ReDim reglas(1 To UBound(datos, 1))
    For i = 1 To UBound(datos, 1)
        If Len(Trim$(Limpiar(datos(i, 1)))) > 0 Then
            n = n + 1
            With reglas(n)
                .ColSalida = ColumnaANumero(Limpiar(datos(i, 1)))
                .Cabecera = Trim$(Limpiar(datos(i, 2)))
                .Operacion = UCase$(Trim$(Limpiar(datos(i, 3))))
                .Origen = Trim$(Limpiar(datos(i, 4)))
                .Hoja = Trim$(Limpiar(datos(i, 5)))
                .SiNoEncontrado = Trim$(Limpiar(datos(i, 8)))
                Select Case .Operacion
                    Case "COPIAR", "SI_NO"
                        .ColsOrigen = Columnas(.Origen, "Mapeo fila " & i + 1)
                    Case "FIJO"
                        ReDim .ColsOrigen(0 To 0)
                    Case "BUSCAR", "CRUZAR"
                        .ColsOrigen = Columnas(.Origen, "Mapeo fila " & i + 1)
                        If Len(.Hoja) = 0 Or Len(Trim$(Limpiar(datos(i, 6)))) = 0 Or Len(Trim$(Limpiar(datos(i, 7)))) = 0 Then
                            Err.Raise vbObjectError + 505, , "Mapeo fila " & i + 1 & ": BUSCAR/CRUZAR necesita Hoja, ColumnasClave y ColumnaValor."
                        End If
                        ' Un diccionario por (hoja, claves, valor); se reutiliza entre reglas.
                        claveCache = .Hoja & "|" & UCase$(Limpiar(datos(i, 6))) & "|" & UCase$(Limpiar(datos(i, 7)))
                        If Not caches.Exists(claveCache) Then
                            caches.Add claveCache, DiccionarioDe(Hoja(.Hoja), Limpiar(datos(i, 6)), Limpiar(datos(i, 7)))
                        End If
                        Set .Dict = caches(claveCache)
                    Case Else
                        Err.Raise vbObjectError + 506, , "Mapeo fila " & i + 1 & ": operacion desconocida '" & .Operacion & "'."
                End Select
            End With
        End If
    Next i
    If n = 0 Then Err.Raise vbObjectError + 504, , "La hoja Mapeo no tiene reglas."
    ReDim Preserve reglas(1 To n)
    LeerReglas = n
End Function

Private Function Columnas(ByVal texto As String, ByVal donde As String) As Long()
    Dim trozos() As String, r() As Long, i As Long
    If Len(Trim$(texto)) = 0 Then Err.Raise vbObjectError + 507, , donde & ": falta la columna de origen."
    trozos = Split(texto, "|")
    ReDim r(0 To UBound(trozos))
    For i = 0 To UBound(trozos)
        r(i) = ColumnaANumero(Trim$(trozos(i)))
    Next i
    Columnas = r
End Function

' Diccionario clave compuesta ("A|B") -> valor. Primera aparicion gana,
' comparacion sin distinguir mayusculas, claves recortadas; la fila 1 se
' incluye por si la tabla no tiene cabecera.
Private Function DiccionarioDe(ByVal ws As Worksheet, ByVal columnasClave As String, ByVal colValor As String) As Object
    Dim d As Object, cols() As Long, cV As Long, maxCol As Long, ult As Long, datos As Variant, i As Long, j As Long, k As String
    Set d = CreateObject("Scripting.Dictionary"): d.CompareMode = vbTextCompare
    cols = Columnas(columnasClave, "Maestro " & ws.Name)
    cV = ColumnaANumero(colValor): maxCol = cV
    For j = 0 To UBound(cols)
        If cols(j) > maxCol Then maxCol = cols(j)
    Next j
    ult = UltimaFila(ws, cols(0))
    If ult >= 1 Then
        datos = ws.Range(ws.Cells(1, 1), ws.Cells(ult, maxCol)).Value
        For i = 1 To ult
            k = ClaveDe(datos, i, cols)
            If Len(Replace(k, "|", "")) > 0 And Not d.Exists(k) Then d.Add k, Valor(datos(i, cV))
        Next i
    End If
    Set DiccionarioDe = d
End Function

Private Function ClaveDe(ByRef datos As Variant, ByVal fila As Long, ByRef cols() As Long) As String
    Dim j As Long, k As String
    For j = 0 To UBound(cols)
        If j > 0 Then k = k & "|"
        k = k & Limpiar(datos(fila, cols(j)))
    Next j
    ClaveDe = k
End Function

' ---------- Maestros al libro de salida ----------
Private Sub CopiarMaestros(ByVal wbOut As Workbook, ByRef reglas() As Regla, ByVal n As Long)
    Dim hechas As Object, i As Long
    Set hechas = CreateObject("Scripting.Dictionary"): hechas.CompareMode = vbTextCompare
    For i = 1 To n
        If (reglas(i).Operacion = "BUSCAR" Or reglas(i).Operacion = "CRUZAR") And Not hechas.Exists(reglas(i).Hoja) Then
            hechas.Add reglas(i).Hoja, True
            Hoja(reglas(i).Hoja).Copy After:=wbOut.Worksheets(wbOut.Worksheets.Count)
        End If
    Next i
End Sub

' ---------- Auxiliares ----------
Private Function Hoja(ByVal nombre As String) As Worksheet
    On Error Resume Next
    Set Hoja = ThisWorkbook.Worksheets(nombre)
    On Error GoTo 0
    If Hoja Is Nothing Then Err.Raise vbObjectError + 500, , "Falta la hoja '" & nombre & "'."
End Function

Private Function SiNo(ByVal valor As Variant) As String
    Select Case UCase$(Trim$(CStr(valor & "")))
        Case "S", "SI", "SÍ", "Y", "YES", "1", "TRUE", "VERDADERO", "X": SiNo = "Sí"
        Case "N", "NO", "0", "FALSE", "FALSO": SiNo = "No"
        Case Else: SiNo = ""
    End Select
End Function

' Conserva numeros y fechas como tales; recorta los textos; los errores quedan vacios.
Private Function Valor(ByVal v As Variant) As Variant
    If IsError(v) Then
        Valor = ""
    ElseIf VarType(v) = vbString Then
        Valor = Trim$(v)
    Else
        Valor = v
    End If
End Function

Private Function Limpiar(ByVal valor As Variant) As String
    If IsError(valor) Then Limpiar = "" Else Limpiar = Trim$(CStr(valor & ""))
End Function