' Desarrollado por Adal Pérez
' Copia para evaluación. Leer LEEME.txt antes de ejecutar.
' Código de cálculo sin cambios; limpieza limitada a comentarios.

Option Explicit

'============================================================
' MACRO: Generar CSV cruzando CSV base contra CATÁLOGO
' VERSIÓN SIN ADODB.Stream - MATCH MEJORADO
'
' Corrige el Error 3002: "No se pudo abrir el archivo".
' Esta versión NO lee el CSV con ADODB; lo abre con Excel como
' libro temporal, lee sus columnas y luego lo cierra sin guardar.
'
' Mejora importante:
' - Evita que EXCAVACIÓN EN ROCA tome la cantidad de
'   EXCAVACIÓN EN CUALQUIER MATERIAL EXCEPTO ROCA.
' - Penaliza candidatos con palabras extra importantes.
' - Penaliza incompatibilidades con EXCEPTO ROCA.
'
' Uso:
' 1) Abre el Excel "CATÁLOGO Y GENERADORES ...xlsx/xlsm".
' 2) Alt + F11 > Insertar > Módulo.
' 3) Pega todo este código completo.
' 4) Ejecuta: GenerarCSV_CruceCatalogo
' 5) Selecciona el CSV base cuando lo pida.
'
' Resultado:
' - Genera un CSV en la misma carpeta del Excel.
' - El nombre sale del archivo Excel quitando el inicio:
'   "CATÁLOGO Y GENERADORES"
'   Ejemplo: CATÁLOGO Y GENERADORES EJEMPLO.xlsx -> EJEMPLO.csv
'============================================================

Private Const HOJA_CATALOGO As String = "CATÁLOGO"
Private Const FILA_INICIO_CATALOGO As Long = 13
Private Const COLUMNA_DESC_XLSX As String = "C"
Private Const COLUMNA_CANT_XLSX As String = "D"
Private Const COLUMNA_UNIDAD_XLSX As String = "E"

' En el CSV: A = descripción, B = cantidad, C = unidad
Private Const COL_DESC_CSV As Long = 1
Private Const COL_CANT_CSV As Long = 2
Private Const COL_UNIDAD_CSV As Long = 3

' Ajustes de coincidencia no exacta.
' Esta versión penaliza conceptos demasiado largos cuando el CSV es corto,
' y evita confundir conceptos tipo:
' EXCAVACIÓN EN ROCA vs EXCAVACIÓN EN CUALQUIER MATERIAL EXCEPTO ROCA.
Private Const PUNTAJE_MINIMO As Double = 0.55

' True = toma también la unidad desde el XLSX columna E.
' False = conserva la unidad que ya viene en el CSV base.
Private Const USAR_UNIDAD_DEL_XLSX As Boolean = True

' Constante para guardar CSV UTF-8. La declaramos numérica para que funcione
' aunque Excel no reconozca el nombre xlCSVUTF8 en algunas versiones.
Private Const FORMATO_CSV_UTF8 As Long = 62

Public Sub GenerarCSV_CruceCatalogo()
    Dim wbBase As Workbook, ws As Worksheet
    Dim csvEntrada As String, carpetaSalida As String, nombreSalida As String, rutaSalida As String
    Dim conceptos As Variant, datosCsv As Variant, salida As Variant
    Dim i As Long, total As Long, encontrados As Long, sinCoincidencia As Long
    Dim descCsv As String, cantidad As Variant, unidad As String
    Dim mejorFila As Long, mejorScore As Double
    Dim logNoEncontrados As String

    On Error GoTo ErrHandler

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wbBase = ActiveWorkbook
    If wbBase Is Nothing Then Err.Raise vbObjectError + 100, , "No hay un libro de Excel activo."

    Set ws = ObtenerHojaCatalogo(wbBase)
    If ws Is Nothing Then
        MsgBox "No encontré la hoja '" & HOJA_CATALOGO & "' en el libro activo." & vbCrLf & _
               "Revisa que estés ejecutando el macro desde el Excel CATÁLOGO Y GENERADORES correcto.", vbCritical
        GoTo SalidaSegura
    End If

    csvEntrada = SeleccionarCSV()
    If Len(csvEntrada) = 0 Then GoTo SalidaSegura

    conceptos = CargarConceptosCatalogo(ws)
    If IsEmpty(conceptos) Then
        MsgBox "No encontré conceptos válidos con descripción en C, cantidad en D y unidad en E dentro de CATÁLOGO.", vbCritical
        GoTo SalidaSegura
    End If

    datosCsv = LeerCSVConExcel(csvEntrada)
    If IsEmpty(datosCsv) Then
        MsgBox "No pude leer filas del CSV seleccionado.", vbCritical
        GoTo SalidaSegura
    End If

    ReDim salida(1 To UBound(datosCsv, 1), 1 To 3)

    For i = 1 To UBound(datosCsv, 1)
        descCsv = Trim$(CStr(datosCsv(i, COL_DESC_CSV)))

        If Len(descCsv) > 0 Then
            total = total + 1
            BuscarMejorCoincidencia descCsv, conceptos, mejorFila, mejorScore

            If mejorFila > 0 And mejorScore >= PUNTAJE_MINIMO Then
                encontrados = encontrados + 1
                cantidad = conceptos(mejorFila, 2)

                If USAR_UNIDAD_DEL_XLSX Then
                    unidad = CStr(conceptos(mejorFila, 3))
                Else
                    unidad = CStr(datosCsv(i, COL_UNIDAD_CSV))
                End If

                salida(i, 1) = descCsv
                salida(i, 2) = FormatoCantidadCSV(cantidad)
                salida(i, 3) = unidad
            Else
                sinCoincidencia = sinCoincidencia + 1
                logNoEncontrados = logNoEncontrados & "- " & descCsv & vbCrLf

                ' Si no hay coincidencia confiable, conserva lo que traía el CSV base.
                salida(i, 1) = descCsv
                salida(i, 2) = CStr(datosCsv(i, COL_CANT_CSV))
                salida(i, 3) = CStr(datosCsv(i, COL_UNIDAD_CSV))
            End If
        Else
            salida(i, 1) = CStr(datosCsv(i, COL_DESC_CSV))
            salida(i, 2) = CStr(datosCsv(i, COL_CANT_CSV))
            salida(i, 3) = CStr(datosCsv(i, COL_UNIDAD_CSV))
        End If
    Next i

    carpetaSalida = wbBase.Path
    If Len(carpetaSalida) = 0 Then carpetaSalida = CurDir$

    nombreSalida = NombreSalidaDesdeWorkbook(wbBase.Name)
    rutaSalida = carpetaSalida & Application.PathSeparator & nombreSalida & ".csv"

    GuardarArrayComoCSV_UTF8 salida, rutaSalida

    Dim msg As String
    msg = "CSV generado:" & vbCrLf & rutaSalida & vbCrLf & vbCrLf & _
          "Filas procesadas: " & total & vbCrLf & _
          "Coincidencias encontradas: " & encontrados & vbCrLf & _
          "Sin coincidencia confiable: " & sinCoincidencia

    If sinCoincidencia > 0 Then
        msg = msg & vbCrLf & vbCrLf & "Conceptos sin coincidencia:" & vbCrLf & logNoEncontrados
    End If

    MsgBox msg, vbInformation

SalidaSegura:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
End Sub

Private Function ObtenerHojaCatalogo(ByVal wb As Workbook) As Worksheet
    On Error Resume Next
    Set ObtenerHojaCatalogo = wb.Worksheets(HOJA_CATALOGO)
    On Error GoTo 0
End Function

Private Function SeleccionarCSV() As String
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
        .Title = "Selecciona el CSV base para cruzar"
        .Filters.Clear
        .Filters.Add "Archivos CSV", "*.csv"
        .AllowMultiSelect = False
        If .Show <> -1 Then
            SeleccionarCSV = ""
        Else
            SeleccionarCSV = .SelectedItems(1)
        End If
    End With
End Function

Private Function LeerCSVConExcel(ByVal rutaCsv As String) As Variant
    Dim wbCsv As Workbook, wsCsv As Worksheet
    Dim lastRow As Long, arr As Variant

    On Error GoTo ErrLeer

    ' Abre el CSV con Excel como libro temporal. Origin:=65001 fuerza UTF-8.
    Workbooks.OpenText Filename:=rutaCsv, _
                       Origin:=65001, _
                       DataType:=xlDelimited, _
                       TextQualifier:=xlTextQualifierDoubleQuote, _
                       ConsecutiveDelimiter:=False, _
                       Tab:=False, _
                       Semicolon:=False, _
                       Comma:=True, _
                       Space:=False, _
                       Other:=False, _
                       Local:=False

    Set wbCsv = ActiveWorkbook
    Set wsCsv = wbCsv.Worksheets(1)

    lastRow = wsCsv.Cells(wsCsv.Rows.Count, COL_DESC_CSV).End(xlUp).Row
    If lastRow < 1 Then GoTo CerrarVacio

    ' Solo necesitamos columnas A:C del CSV base.
    arr = wsCsv.Range(wsCsv.Cells(1, 1), wsCsv.Cells(lastRow, 3)).Value
    wbCsv.Close SaveChanges:=False

    LeerCSVConExcel = arr
    Exit Function

CerrarVacio:
    wbCsv.Close SaveChanges:=False
    LeerCSVConExcel = Empty
    Exit Function

ErrLeer:
    On Error Resume Next
    If Not wbCsv Is Nothing Then wbCsv.Close SaveChanges:=False
    On Error GoTo 0
    Err.Raise Err.Number, , "No se pudo abrir o leer el CSV con Excel. Ruta: " & rutaCsv & vbCrLf & Err.Description
End Function

Private Sub GuardarArrayComoCSV_UTF8(ByVal arr As Variant, ByVal rutaSalida As String)
    Dim wbOut As Workbook, wsOut As Worksheet
    Dim filas As Long

    On Error GoTo ErrGuardar

    filas = UBound(arr, 1)

    Set wbOut = Workbooks.Add(xlWBATWorksheet)
    Set wsOut = wbOut.Worksheets(1)

    wsOut.Range("A1").Resize(filas, 3).NumberFormat = "@"
    wsOut.Range("A1").Resize(filas, 3).Value = arr

    ' Si ya existe el archivo de salida, se reemplaza.
    If Len(Dir$(rutaSalida)) > 0 Then Kill rutaSalida

    wbOut.SaveAs Filename:=rutaSalida, FileFormat:=FORMATO_CSV_UTF8, CreateBackup:=False, Local:=False
    wbOut.Close SaveChanges:=False
    Exit Sub

ErrGuardar:
    On Error Resume Next
    If Not wbOut Is Nothing Then wbOut.Close SaveChanges:=False
    On Error GoTo 0
    Err.Raise Err.Number, , "No se pudo guardar el CSV de salida. Ruta: " & rutaSalida & vbCrLf & Err.Description
End Sub

Private Function CargarConceptosCatalogo(ByVal ws As Worksheet) As Variant
    Dim lastRow As Long, r As Long, n As Long
    Dim desc As String, cant As Variant
    Dim tmp() As Variant

    lastRow = ws.Cells(ws.Rows.Count, COLUMNA_DESC_XLSX).End(xlUp).Row

    ' Primero contamos conceptos válidos.
    For r = FILA_INICIO_CATALOGO To lastRow
        desc = Trim$(CStr(ws.Cells(r, COLUMNA_DESC_XLSX).Value))
        cant = ws.Cells(r, COLUMNA_CANT_XLSX).Value
        If Len(desc) > 0 And Len(Trim$(CStr(cant))) > 0 And IsNumeric(cant) Then
            n = n + 1
        End If
    Next r

    If n = 0 Then
        CargarConceptosCatalogo = Empty
        Exit Function
    End If

    ReDim tmp(1 To n, 1 To 4)
    n = 0

    For r = FILA_INICIO_CATALOGO To lastRow
        desc = Trim$(CStr(ws.Cells(r, COLUMNA_DESC_XLSX).Value))
        cant = ws.Cells(r, COLUMNA_CANT_XLSX).Value

        If Len(desc) > 0 And Len(Trim$(CStr(cant))) > 0 And IsNumeric(cant) Then
            n = n + 1
            tmp(n, 1) = desc
            tmp(n, 2) = CDbl(cant)
            tmp(n, 3) = Trim$(CStr(ws.Cells(r, COLUMNA_UNIDAD_XLSX).Value))
            tmp(n, 4) = NormalizaTexto(desc)
        End If
    Next r

    CargarConceptosCatalogo = tmp
End Function

Private Sub BuscarMejorCoincidencia(ByVal descCsv As String, ByRef conceptos As Variant, _
                                     ByRef mejorFila As Long, ByRef mejorScore As Double)
    Dim i As Long, score As Double
    Dim normCsv As String, normXlsx As String

    mejorFila = 0
    mejorScore = 0
    normCsv = NormalizaTexto(descCsv)

    For i = LBound(conceptos, 1) To UBound(conceptos, 1)
        normXlsx = CStr(conceptos(i, 4))
        score = PuntajeCoincidencia(normCsv, normXlsx)

        If score > mejorScore Then
            mejorScore = score
            mejorFila = i
        End If
    Next i
End Sub

Private Function PuntajeCoincidencia(ByVal corto As String, ByVal largo As String) As Double
    Dim base As Double, penalidadLongitud As Double
    Dim tokensCortoUtiles As Long, tokensLargoUtiles As Long

    If Len(corto) = 0 Or Len(largo) = 0 Then
        PuntajeCoincidencia = 0
        Exit Function
    End If

    ' Regla específica pero muy importante:
    ' "EXCAVACION EN ROCA" NO debe empatar ni ganar contra
    ' "EXCAVACION EN CUALQUIER MATERIAL EXCEPTO ROCA".
    If ContieneToken(corto, "ROCA") And Not ContieneToken(corto, "EXCEPTO") Then
        If InStr(1, " " & largo & " ", " EXCEPTO ROCA ", vbTextCompare) > 0 Then
            PuntajeCoincidencia = 0
            Exit Function
        End If
    End If

    ' Si una descripción habla de EXCEPTO y la otra no, normalmente son conceptos distintos.
    If ContieneToken(corto, "EXCEPTO") <> ContieneToken(largo, "EXCEPTO") Then
        base = PuntajePorTokens(corto, largo) * 0.35
        PuntajeCoincidencia = base
        Exit Function
    End If

    ' Coincidencia exacta normalizada: máxima confianza.
    If corto = largo Then
        PuntajeCoincidencia = 1.5
        Exit Function
    End If

    ' Si el texto corto aparece como frase completa dentro del largo, es buena coincidencia,
    ' pero no perfecta: se penaliza si el largo trae muchas palabras extra.
    If InStr(1, " " & largo & " ", " " & corto & " ", vbTextCompare) > 0 Then
        tokensCortoUtiles = ContarTokensUtiles(corto)
        tokensLargoUtiles = ContarTokensUtiles(largo)

        If tokensLargoUtiles > 0 Then
            penalidadLongitud = tokensCortoUtiles / tokensLargoUtiles
        Else
            penalidadLongitud = 1
        End If

        PuntajeCoincidencia = 1 + (0.25 * penalidadLongitud)
        Exit Function
    End If

    base = PuntajePorTokens(corto, largo)

    tokensCortoUtiles = ContarTokensUtiles(corto)
    tokensLargoUtiles = ContarTokensUtiles(largo)

    ' Penaliza candidatos del XLSX mucho más largos que el concepto del CSV.
    ' Esto rompe empates como:
    ' CSV:  EXCAVACION EN ROCA
    ' XLSX: EXCAVACION EN CUALQUIER MATERIAL EXCEPTO ROCA
    If tokensCortoUtiles > 0 And tokensLargoUtiles > 0 And tokensLargoUtiles > tokensCortoUtiles Then
        penalidadLongitud = tokensCortoUtiles / tokensLargoUtiles
        base = base * (0.65 + 0.35 * penalidadLongitud)
    End If

    PuntajeCoincidencia = base
End Function

Private Function PuntajePorTokens(ByVal corto As String, ByVal largo As String) As Double
    Dim tokens As Variant, t As Variant
    Dim totalPeso As Double, pesoEncontrado As Double
    Dim token As String, peso As Double

    tokens = Split(corto, " ")

    For Each t In tokens
        token = Trim$(CStr(t))
        If Len(token) >= 3 And Not EsPalabraRelleno(token) Then
            peso = PesoToken(token)
            totalPeso = totalPeso + peso
            If ContieneToken(largo, token) Then
                pesoEncontrado = pesoEncontrado + peso
            End If
        End If
    Next t

    If totalPeso = 0 Then
        PuntajePorTokens = 0
    Else
        PuntajePorTokens = pesoEncontrado / totalPeso
    End If
End Function

Private Function ContieneToken(ByVal texto As String, ByVal token As String) As Boolean
    ContieneToken = (InStr(1, " " & texto & " ", " " & token & " ", vbTextCompare) > 0)
End Function

Private Function ContarTokensUtiles(ByVal texto As String) As Long
    Dim tokens As Variant, t As Variant, token As String, n As Long

    tokens = Split(texto, " ")
    For Each t In tokens
        token = Trim$(CStr(t))
        If Len(token) >= 3 And Not EsPalabraRelleno(token) Then
            n = n + 1
        End If
    Next t

    ContarTokensUtiles = n
End Function

Private Function PesoToken(ByVal token As String) As Double
    ' Da más peso a números, medidas y palabras muy descriptivas.
    If token Like "*[0-9]*" Then
        PesoToken = 2.5
    ElseIf Len(token) >= 8 Then
        PesoToken = 1.5
    Else
        PesoToken = 1
    End If
End Function

Private Function EsPalabraRelleno(ByVal token As String) As Boolean
    Select Case token
        Case "CON", "DEL", "LAS", "LOS", "PARA", "POR", "UNA", "UNO", "QUE", "Y/O", "INCLUYE", _
             "OBRA", "EQUIPO", "MANO", "HERRAMIENTA", "HERRAMIENTAS", "SUMINISTRO", _
             "COLOCACION", "FABRICACION", "INSTALACION", "ACARREO", "CARGA", "DESCARGA"
            EsPalabraRelleno = True
        Case Else
            EsPalabraRelleno = False
    End Select
End Function

Private Function NormalizaTexto(ByVal s As String) As String
    s = UCase$(s)
    s = Replace(s, ChrW(&HFEFF), "") ' Quitar BOM UTF-8 si viene al inicio del CSV

    ' Quitar acentos y caracteres frecuentes.
    s = Replace(s, "Á", "A")
    s = Replace(s, "É", "E")
    s = Replace(s, "Í", "I")
    s = Replace(s, "Ó", "O")
    s = Replace(s, "Ú", "U")
    s = Replace(s, "Ü", "U")
    s = Replace(s, "Ñ", "N")

    ' Normalizar abreviaturas comunes.
    s = Replace(s, "D.E.", "DIAMETRO EXTERIOR")
    s = Replace(s, "D.E", "DIAMETRO EXTERIOR")
    s = Replace(s, "DIAM.", "DIAMETRO")
    s = Replace(s, "DIAM", "DIAMETRO")
    s = Replace(s, "F'C", "FC")
    s = Replace(s, "f'c", "FC")

    ' Homologar comillas especiales.
    s = Replace(s, ChrW(8220), Chr(34))
    s = Replace(s, ChrW(8221), Chr(34))

    ' Quitar puntuación, conservando números y palabras.
    s = Replace(s, ",", " ")
    s = Replace(s, ".", " ")
    s = Replace(s, ";", " ")
    s = Replace(s, ":", " ")
    s = Replace(s, "(", " ")
    s = Replace(s, ")", " ")
    s = Replace(s, "[", " ")
    s = Replace(s, "]", " ")
    s = Replace(s, "{", " ")
    s = Replace(s, "}", " ")
    s = Replace(s, "'", " ")
    s = Replace(s, Chr(34), " ")
    s = Replace(s, "“", " ")
    s = Replace(s, "”", " ")
    s = Replace(s, "=", " ")
    s = Replace(s, "-", " ")
    s = Replace(s, "/", " ")
    s = Replace(s, "²", "2")
    s = Replace(s, "³", "3")

    Do While InStr(s, "  ") > 0
        s = Replace(s, "  ", " ")
    Loop

    NormalizaTexto = Trim$(s)
End Function

Private Function NombreSalidaDesdeWorkbook(ByVal wbName As String) As String
    Dim base As String, p As Long

    base = wbName
    p = InStrRev(base, ".")
    If p > 0 Then base = Left$(base, p - 1)

    base = Replace(base, "CATÁLOGO Y GENERADORES", "", 1, -1, vbTextCompare)
    base = Replace(base, "CATALOGO Y GENERADORES", "", 1, -1, vbTextCompare)
    base = Replace(base, "CATÁLOGO Y GENERADORES", "", 1, -1, vbTextCompare) ' Variante con acento combinado

    base = Trim$(base)
    Do While Len(base) > 0 And (Left$(base, 1) = "-" Or Left$(base, 1) = "_")
        base = Trim$(Mid$(base, 2))
    Loop

    If Len(base) = 0 Then base = "cruce_resultado"
    NombreSalidaDesdeWorkbook = base
End Function

Private Function FormatoCantidadCSV(ByVal v As Variant) As String
    Dim d As Double, s As String

    If Not IsNumeric(v) Then
        FormatoCantidadCSV = CStr(v)
        Exit Function
    End If

    d = Round(CDbl(v), 2)
    s = Format$(d, "0.00")

    ' Asegura punto decimal aunque Excel esté en configuración regional con coma.
    s = Replace(s, Application.DecimalSeparator, ".")

    ' Quitar ceros finales: 8.00 -> 8 ; 4.50 -> 4.5
    Do While InStr(s, ".") > 0 And Right$(s, 1) = "0"
        s = Left$(s, Len(s) - 1)
    Loop
    If Right$(s, 1) = "." Then s = Left$(s, Len(s) - 1)

    FormatoCantidadCSV = s
End Function
