jueves, 21 de octubre de 2021

Power Pivot: diferencia con dato previo con condición

En la entrada del blog anterior vimos cómo obtener la diferencia con el dato previo, teniendo en cuenta un criterio temporal y una condición adicional (por ejemplo de país) usando Power Query... donde se comentó la lentitud de ejecución para un número elevado de filas...
Un estándar en el uso de Power Query.

Y es aquí donde, además de otros motivos, aparece Power Pivot, donde demuestra su potencia de procesamiento...
En esta entrada replicaremos con lenguaje DAX el cálculo necesario para obtener la diferencia con el dato anterior, cumpliendo los requisitos temporales y de País definidos.
Power Pivot: diferencia con dato previo con condición


Tenemos al menos dos alternativas de inicio.
Primera: Realizar la carga de la tabla de datos origen a través de Power Query, y de paso, en el proceso añadirle una columna de Índice.
Segunda: Cargar directamente la tabla origen a Power Pivot y agregar una columna calculada que replique un Índice.

Veamos primero cuál sería el proceso si hacemos la carga en el Modelo de datos a través de Power Query.
Cargamos nuestra tabla origen en el editor de Power Query, donde agregremos una columna de Índice.
Power Pivot: diferencia con dato previo con condición

Con el Índice agregado procedemos a Cargar y Cerrar la consulta, añadiéndola al Modelo de datos.

Accederemos ahora al modelo de datos de Power Pivot en Excel, donde insertaremos la siguiente columna calculada:
= VAR FilaAnterior=TblDATOS_PP[Índice]-1
VAR LOC=TblDATOS_PP[País]
VAR DatoPrevio=
    CALCULATE (
            VALUES (   TblDATOS_PP[Importe]   );
            FILTER ( ALL ( TblDATOS_PP); (TblDATOS_PP[País]=LOC)  && VALUE(TblDATOS_PP[Índice]) = VALUE(FilaAnterior ))
        )
 VAR DatoCorriente = TblDATOS_PP[Importe]
 VAR Calc =  IF(DatoPrevio ;DatoCorriente-DatoPrevio;0)
RETURN
Calc

Power Pivot: diferencia con dato previo con condición


Nuestra fórmula DAX nos ayuda mediante el uso de variables a construir o recuperar los datos necesarios para el cálculo de la diferencia buscada.
VAR FilaAnterior=TblDATOS_PP[Índice]-1
devolvería el dato de la columna Índice de cada fila, restándole 1.

VAR LOC=TblDATOS_PP[País]
el dato de la columna País de la fila... VAR DatoPrevio= CALCULATE ( VALUES ( TblDATOS_PP[Importe] ); FILTER ( ALL ( TblDATOS_PP); (TblDATOS_PP[País]=LOC) && VALUE(TblDATOS_PP[Índice]) = VALUE(FilaAnterior )) )
en este caso recuperamos el dato de la columna 'Importe' cuando se cumpla la doble condición:
- el dato de la fila actual coincida con el País definido en la variable previa
- y además se cumpla que el dato de la columna Índice sea el mismo que el de la variable 'FilaAnterior'.

La siguiente variable VAR DatoCorriente = TblDATOS_PP[Importe]
recupera el 'Importe' de la fila corriente...

El resto es fácil de interpretar, tenemos el 'Importe' actual y el 'Importe' previo... así que solo nos queda restar uno al otro.

En el siguiente método cargamos o añadimos directamente la tabla fuente al modelo de datos.
Al acceder al modelo de datos podemos añadir una nueva columna calculada que replique el Índice, incorporando la fórmula DAX:
=RANKX(ALL(TblDATOS_PP);
		TblDATOS_PP[País] & VALUE(TblDATOS_PP[Fecha])
		;;ASC;Dense)-1

Power Pivot: diferencia con dato previo con condición


Notemos el uso de la doble condición país+fecha que hacemos en RANKX, y cómo debemos 'convertir' en valor la Fecha para que proceda con el orden adecuado...

Con el índice obtenido mediante DAX, podríamos aplicar la misma fórmula descrita anteriormente... completando el cálculo deseado.

martes, 19 de octubre de 2021

Power Query: Diferencia dato previo condicionado

Este es sin duda un clásico de los cálculos: Obtener la diferencia con el dato previo, teniendo en cuenta un criterio temporal y una condición adicional (por ejemplo de país)
Power Query: Diferencia dato previo condicionado


Hace algún tiempo ya publiqué una forma de llegar a este dato (sin cumplir condición) simplemente siguiendo unos pasos a través del menú, empleando el truco de combinar la misma consulta sobre si misma...

En el caso de hoy añadimos una dificultad más, y es que las diferencias obtenidas deben respetar al conjunto de cada país, de tal forma que el primer dato de cada país no calcule diferencia sobre el último dato del país anterior... tal como se puede ver en la imagen anterior.

Así pues cargaremos nuestra tabla de datos al editor de Power Query como siempre, solo como conexión.
Y sin salir del editor crearemos una consulta en blanco donde escribiremos el siguiente código M:
let
    Origen = TblDATOS,
    //ordenamos la tabla por dos criterios: Primero por País y dentro de cada País por fecha
    FilasOrdenadas = Table.Sort(Origen,{{"País", Order.Ascending}, {"Fecha", Order.Ascending}}),
    //añadimos una columna con un índice comenzando en 0
    ÍndiceAgregado = Table.AddIndexColumn(FilasOrdenadas, "Índice", 0, 1, Int64.Type),

    //en este primer paso agregamos una columna donde aplica la diferencia 
    //de todas las filas respecto a la anterior... sin condiciones
    //nos apoyamos en la recién creada columna Índice
    AddCol_Delta1 = Table.AddColumn(ÍndiceAgregado, 
                        "Delta", 
                        each try [Importe]-FilasOrdenadas{[Índice]-1}[Importe] otherwise  null),

    //Agregamos una nueva columna que contenga una tabla con las filas filtradas de cada País
    //donde adicionalmente hemos incorporado un nuevo índice (independiente para cada País)
    //y sobre ese índice nuevo, calculamos la diferencia con el anterior dato
    AddCol_Delta2 = Table.AddColumn(AddCol_Delta1,
                        "Intermedio",
                        each
                        let
                            tblFiltroIndex=let 
                                p=[País],
                                TablaPAIS=Table.SelectRows(ÍndiceAgregado, each [País]=p),
                                AddIndice=Table.AddIndexColumn(TablaPAIS, "ÍndiceCondicion", 0, 1, Int64.Type)
                            in
                                Table.AddColumn(AddIndice,
                                   "DeltaSub",
                                   each try _[Importe]-AddIndice{[ÍndiceCondicion]-1}[Importe] otherwise null)
                        in
                            tblFiltroIndex  ),
    
    //finalmente recuperamos, en una nueva columna agregada, la diferencia obtenida en el paso anterior
    //solo cuando tengamos la coincidencia de Pais y Fecha...
    Coincidencia=Table.AddColumn(AddCol_Delta2, 
                        "Delta_Condicion",
                        each let 
                            p=[País], f=[Fecha], i=[Importe]
                            in 
                                Table.SelectRows([Intermedio], each [País]=p and [Fecha]=f and [Importe]=i)[DeltaSub]{0})
in
    Coincidencia

Power Query: Diferencia dato previo condicionado

Listo... al ejecutar la consulta obtenemos los datos esperados!!

El método empleado es una constante en Power Query, ir añadiendo columnas que faciliten el proceso o evolución del cálculo.
Relevante el uso de la expresión let...in...; sabiendo que la expresión let 'encapsula' un conjunto de valores que se van a calcular, a los que se van a asignar nombres (constantes o variables) que finalmente se van a usar en una expresión subsiguiente que sigue a la instrucción in.
Es decir, nos permite realizar cálculos intermedios dentro del proceso de creación de nuevas columnas...

Por ejemplo, el último paso de nuestra consulta:
Coincidencia=Table.AddColumn(AddCol_Delta2, 
                        "Delta_Condicion",
                        each let 
                            p=[País], f=[Fecha], i=[Importe]
                            in 
                                Table.SelectRows([Intermedio], each [País]=p and [Fecha]=f and [Importe]=i)[DeltaSub]{0})


Al mismo tiempo que agregamos una nueva columna 'Delta_Condición', procesamos un cálculo para tres variables:
p=[País], f=[Fecha], i=[Importe]
sobre las que se trabaja en la salida del in
donde realizamos una selección de filas con Table.SelectRows donde se cumplan las condiciones de igualdad definidas...

Un ejercicio interesante sin duda...

Un inconveniente del método descrito es que para un volumen alto de filas, el tiempo de ejecución es elevado :'(

jueves, 14 de octubre de 2021

VBA: Midiendo tiempos de ejecución

Muy frecuentemente, cuando trabajo con mis clientes, me preguntan qué fórmula es mejor y cúal es más rápida o ágil a la hora del cálculo... No hay una respuesta fácil, por que depende de la situación y contexto, a veces no es posible optar por la mejor... y nos conformamos 'con la menos mala'.
En todo caso hoy publicaré una macro proporcionada entre la documentación de Microsoft que nos permitirá medir los tiempos que emplea una fórmula o conjunto de ellas en ejecutarse completamente.
Es una macro muy vieja, pero poco conocida... por ese motivo me permito hacerle un poco de publicidad ;-)

Es una manera muy cómoda de controlar tiempos y decidir, en su caso, si buscamos una alternativa a la función desarrollada....

Añadiremos en un módulo estándar del editor de VBA (o si lo prefieres en el libro de macros personal) el siguiente conjunto de procedimientos.

En primer lugar llamamos a las funciones API de Windows según la versión de nuestro editor de VBA:
'preparación para emplear unas librerias y funciones API u otras según la versión de VBA que tengamos
'las dos funciones que necesitamos son:
'getFrequency
'getTickCount

#If VBA7 Then
    Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
         "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
    Private Declare Function getFrequency Lib "kernel32" Alias _
        "QueryPerformanceFrequency" (cyFrequency As Currency) As Long
    Private Declare Function getTickCount Lib "kernel32" Alias _
        "QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If


A continuación, empleando estas funciones, definimos una función 'temporizador':
Function MicroTimer() As Double
' Mide los segundos empleados...
Dim cyTicks1 As Currency
Static cyFrequency As Currency
'
MicroTimer = 0

' Obtenemos la frecuencia a partir de la función API 'getFrequency'
'función que hemos llamado en las primeras líneas
If cyFrequency = 0 Then getFrequency cyFrequency

' Obtenemos los ticks a partir de la función API 'getTickCount'
getTickCount cyTicks1

' y calculamos los segundos a través del cociente entre ticks y frecuencia
If cyFrequency Then MicroTimer = cyTicks1 / cyFrequency
End Function


Empleando esta UDF recién creada, que es capaz de contabilizar segundos... insertamos el procedimiento que se encargará de procesar de acuerdo a la elección del usuario, los tiempos de ejecución de un:
-rango/celda
-la hoja activa
-el libro activo de trabajo
-todos los libros abiertos

Insertamos pues, a continuación, el siguiente procedimiento:
Sub DoCalcTimer(jMethod As String)
Dim dTime As Double
Dim dOvhd As Double
Dim oRng As Range
Dim oCell As Range
Dim oArrRange As Range
Dim sCalcType As String
Dim lCalcSave As Long
Dim bIterSave As Boolean

'controlamos un posible fallo
On Error GoTo Errhandl

' Iniciamos el contador...
dTime = MicroTimer

' guardamos la lconfiguración actual
lCalcSave = Application.Calculation     'de la Opción de cálculo que tengamos
bIterSave = Application.Iteration       'y de la iteración configurada

'la disponemos en Opcion de cálculo manual
If Application.Calculation <> xlCalculationManual Then
    Application.Calculation = xlCalculationManual
End If

'y procesamos el conteo según la elección  del usuario:
' rango o celda
' hoja
' libro activo
' todos los libros activos

'lo gestionamos con un Select Case
Select Case jMethod
Case "celda_rango"  'para el rango/celda seleccionado

    ' Desactivamos la iteración 8si estuviera marcada).
    If Application.Iteration <> False Then
        Application.Iteration = False
    End If
    
    ' Disponemos un topo de celdas seleccionadoas,
    ' y limitamos al UsedRange.
    If Selection.Count > 1000 Then
        Set oRng = Intersect(Selection, Selection.Parent.UsedRange)
    Else
        Set oRng = Selection
    End If

    ' Incluimos otras celdas fuera de la selección
    For Each oCell In oRng
        If oCell.HasArray Then
            If oArrRange Is Nothing Then
                Set oArrRange = oCell.CurrentArray
            End If
            If Intersect(oCell, oArrRange) Is Nothing Then
                Set oArrRange = oCell.CurrentArray
                Set oRng = Union(oRng, oArrRange)
            End If
        End If
    Next oCell
    'preparamos texto recapitulativo (la parte inicial).
    sCalcType = "Calculadas " & CStr(oRng.Count) & " Celda/s en el rango seleccionado en: "
    
Case "hoja"  'para la hoja activa
    sCalcType = "Hoja recalculada " & ActiveSheet.Name & " en: "
Case "libro"  'para el libro de trabajo activo
    sCalcType = "Libro abierto recalculado en: "
Case "todos_libros"  'para todos los libros abiertos
    sCalcType = "Recalculo completo de todos los libros abiertos en: "
End Select

' Reiniciamos el temporizador
dTime = MicroTimer

'y calculamos tiempos según la elección de celda/rango/hoja/libro/libros
'forzando un recálculo controlado de esa celda, rango, hoja, libro o todos los libros...
Select Case jMethod
Case "celda_rango"  'para el rango/celda seleccionado
    If Val(Application.Version) >= 12 Then
        oRng.CalculateRowMajorOrder
    Else
        oRng.Calculate
    End If
Case "hoja"  'para la hoja activa
    ActiveSheet.Calculate
Case "libro"  'para el libro de trabajo activo
    Application.Calculate
Case "todos_libros"  'para todos los libros abiertos
    Application.CalculateFull
End Select

' finalmente calculamos duración del proceso de cálculo.
dTime = MicroTimer - dTime
On Error GoTo 0

'redondeamos
dTime = Round(dTime, 5)
'y mostramos el mensanje final
MsgBox sCalcType & " " & CStr(dTime) & " segundos", vbOKOnly + vbInformation, "CalcTimer"


Finish:
    'restauramos opciones de cálculo e iteración iniciales
    If Application.Calculation <> lCalcSave Then
         Application.Calculation = lCalcSave
    End If
    If Application.Iteration <> bIterSave Then
         Application.Iteration = bIterSave
    End If
    Exit Sub
    
Errhandl:
    'la salida en caso de error
    On Error GoTo 0
    MsgBox "Unable to Calculate " & sCalcType, vbOKOnly + vbCritical, "CalcTimer"
    GoTo Finish
End Sub


Para terminar incluiremos cuatro 'miniprocedimientos' que nos permitirán ejecutar una de las cuatro opciones:
Sub RangeTimer()
    DoCalcTimer "celda_rango"         
End Sub
''''''''''''''''''''''''''
Sub SheetTimer()
    DoCalcTimer "hoja"                
End Sub
''''''''''''''''''''''''''
Sub RecalcTimer()
    DoCalcTimer "libro"   
End Sub
''''''''''''''''''''''''''
Sub FullcalcTimer()
    DoCalcTimer "todos_libros"        
End Sub


¿Cómo funciona todo esto?. Muy fácil... Selecciona una celda o rango de celdas con funciones o fórmulas, presiona Alt+F8 y ejecuta la macro 'RangeTimer'.
VBA: Midiendo tiempos de ejecución

Aparecerá el mensaje configurado anteriormente indicando el tiempo empleado en completar el cálculo:
VBA: Midiendo tiempos de ejecución


También puedes asignar las macros a botones, o a métodos abreviados ;-)

Muy recomendable ejecutar el proceso dos o tres veces para tener una realidad más precisa del tiempo necesario de recalculo...

De igual forma procederíamos para obtener el cálculo de hoja, libro o todos los libros abierto ;-)

martes, 12 de octubre de 2021

Cálculo del dígito de control de un SSCC

Quizá te estés preguntando que es un SSCC... si es el caso, solo sigue leyendo si te interesan los desarrollos de algoritmos ;-)
El SSCC (Serial Shipping Container Code) es un código de identificación GS1 empleando principalmente en temas logísticos.
Este código SSCC se compone básicamente por cuatro partes, con un total de 18 dígitos (o sea números!!) incluido el dígito de control:
a) Dígito de extensión (un solo dígito)
b) Prefijo de la compañia (ocho dígitos)
c) Un número de referencia (ocho dígitos), y
d) Un dígito de control (un solo dígito).

Adicionalmente se puede añadir otro valor al inicio de estos 18 dígitos un identificador para indicar que es un código SSCC.

Visto qué es y cómo está compuesto este código SSCC, vamos a ver cómo se calcula el dígito de control.
El patrón de cálculo es:
i) Se enumera el código de derecha a izquierda, multiplicando los dígitos que ocupan una posición par por 1, y por 3 los digitos que ocupan posición impar.
ii) A continuación se suman los valores de los productos obtenidos.
iii) Para luego buscar la decena superior al resultado de la suma anterior.
iv) Por último se restan estos dos valores. El resultado obtenido es el digito de control.

Veamos cuál es la fórmula buscada, y desgranémosla:
Cálculo del dígito de control de un SSCC

La fórmula completa, en la celda C2:
=MULTIPLO.SUPERIOR.MAT(SUMA(SI(ES.PAR(LARGO(B2)-SECUENCIA(1;LARGO(B2))+1);1;3)*EXTRAE(B2;SECUENCIA(1;LARGO(B2));1));10)- SUMA(SI(ES.PAR(LARGO(B2)-SECUENCIA(1;LARGO(B2))+1);1;3)*EXTRAE(B2;SECUENCIA(1;LARGO(B2));1))
Si desglosamos la fórmula en partes, reconoceremos el patrón de cálculo comentado más arriba...

En una primera etapa debíamos enumerar el código de derecha a izquierda, multiplicando los dígitos que ocupan una posición par por 1, y por 3 los digitos que ocupan posición impar. Esta parte la conseguimos en nuestra fórmula con:
SI(ES.PAR(LARGO(B2)-SECUENCIA(1;LARGO(B2))+1);1;3)*EXTRAE(B2;SECUENCIA(1;LARGO(B2));1)
La función EXTRAE, junto a SECUENCIA se encarga de trabajar dígito a dígito, identificando su posición, y si esta es par o impar, para según el caso multiplicar por 1 o por 3.

El segundo paso era muy simple. Sumamos el resultado anterior:
SUMA(SI(ES.PAR(LARGO(B2)-SECUENCIA(1;LARGO(B2))+1);1;3)*EXTRAE(B2;SECUENCIA(1;LARGO(B2));1))

En el siguiente punto debemos buscar la decena superior a la suma anterior... para ello trabajaremos con la función MULTIPLO.SUPERIOR.MAT con un argumento de base 10:
MULTIPLO.SUPERIOR.MAT(resultado_suma;10)

Por último, para conseguir el deseado Dígito de control solo restamos ambas cantidades...
tal cual mostraba nuestra fórmula completa.

El detalle del paso a paso lo puedes ver, para los dos ejemplos de la imagen en las columnas E a V

Comentario final. Cuando tenemos que desarrollar algún algoritmo o fórmula en nuestro caso, es fundamental documentarse de todas las opciones y posibilidades que existan y apliquen para el correcto cálculo...

jueves, 7 de octubre de 2021

VBA: Trabajando con XML

Repasaremos hoy algunas formas de trabajar con ficheros XML desde VBA en Excel... ya sabes que este tipo de archivos XML están basados en datos estructurados mediante etiquetas, y son bastante habituales a la hora de traspasar información.

Así pues, en este artículo dejaré algunas macros que nos permitirán:
- Crear un fichero XML a partir de una tabla de Excel.
- Anexar un conjunto de archivos XML en uno solo.
- Importar un archivo XML a una hoja de Excel.
- Obtener el mapa de un archivo XML.

Partiremos de una tabla, llamada 'TblVENTAS' contenida en una hoja de nuestro libro...
VBA: Trabajando con XML

Es una tabla estándar de Excel con seis campos: 'Fecha','Pais','Producto','Unidades','Precio unitario' y 'Total'.

Comencemos creando un archivo XML con el contenido de una tabla en Excel.
En un módulo estándar insertaremos el siguiente código:
Sub ExportaTablas_ToXML()

Dim strXML As String
Dim iFila As Long, iCol As Long
Dim vTabla As Variant, vEncab As Variant

'para las etiquetas de Tabla y fila
Dim sNombreEltoTabla As String
Dim sNombreEltoFila As String
sNombreEltoTabla = "tabla"
sNombreEltoFila = "fila"

Dim ruta As String, fecha As Variant
'Ruta del fichero a generar
ruta = "F:\excelforo\XML_test\fuentes"
fecha = "y" & Year(CDate(Hoja1.Range("A2").Value))

'Carga de datos...
vTabla = Hoja1.ListObjects("TblVENTAS").DataBodyRange.Value
vEncab = Hoja1.ListObjects("TblVENTAS").HeaderRowRange.Value

Dim sRutaArchivoXML As String
sRutaArchivoXML = ruta & "\" & fecha & ".xml"

'construimos el xml
'En un documento XML no es obligatorio que aparezca la declaración XML
'Si se escribe, el atributo version es obligatorio indicarlo.
'los atributos encoding y standalone son opcionales y,
'por defecto, sus valores son "UTF-8" y "no", respectivamente.
'standalone="yes" se está indicando que el documento es independiente de otros

'recorremos cada fila y cada columna de la tabla,
'concatenando valores con 'etiquetas' del XML
'alternado su apertura y cierre de los nodos....
strXML = "<!--?xml version=""1.0"" encoding=""UTF-8""?-->"  'standalone=""yes""
strXML = strXML & "<" & sNombreEltoTabla & ">"
For iFila = 1 To UBound(vTabla, 1)
    strXML = strXML & "<" & sNombreEltoFila & ">"
    For iCol = 1 To UBound(vTabla, 2)
        strXML = strXML & "<" & CStr(Replace(vEncab(1, iCol), " ", "_")) & ">" & _
            vTabla(iFila, iCol) & "</" & CStr(Replace(vEncab(1, iCol), " ", "_")) & ">"
    Next iCol
    strXML = strXML & "</" & sNombreEltoFila & ">"
Next iFila
strXML = strXML & "</" & sNombreEltoTabla & ">"

'Para generar el fichero nuevo de XML
Dim iNumArchivo As Long
'obtenemos el valor del siguiente archivo libre a crear
iNumArchivo = FreeFile

'lo abrimos, cargamos con print(o write) y cerramos
Open sRutaArchivoXML For Output As #iNumArchivo
Print #iNumArchivo, strXML
Close #iNumArchivo

MsgBox "XML Creado"
End Sub

El resultado será un archivo .xml con este aspecto:
VBA: Trabajando con XML

Notemos cómo se han cargado las fechas... su formato es mm/dd/yyyy.

Con el siguiente código conseguimos anexar o juntar en un solo archivo .xml varios ficheros.
Trabajaremos sobre un conjunto de ficheros .xml guardados en una misma carpeta, y por supuesto un mismo mapa. En un módulo estándar del editor de VBA insertamos el siguiente procedimiento:
Sub AnexaXMLs()
Dim rutaCarpetaXMLs As String

Dim inDoc As New MSXML2.DOMDocument60
Dim XMLFinal As New MSXML2.DOMDocument60
Dim rdo As Object, nd

'creamos un Elemento o nivel superior que englobará todos los nodos
'de los distintos archivos...
Set rdo = XMLFinal.appendChild(XMLFinal.createElement("anexado"))
'ruta carpeta donde estén los XML
rutaCarpetaXMLs = "F:\excelforo\XML_test\fuentes\"

Dim archivoXML As Variant

archivoXML = Dir(rutaCarpetaXMLs)
'recorremos la carpeta que contiene los XML
'fichero por fichero
While (archivoXML <> "")
    'cargamos con el método GET el contenido de cada fichero
   Dim XMLSolicitud As New MSXML2.XMLHTTP60
   With XMLSolicitud
        .Open "GET", rutaCarpetaXMLs & archivoXML, False       ',usuario, password
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/59.0.3071.115 Safari/537.36"
        .setRequestHeader "Content-Type", "application/xml"
        .send
       'en realidad esto es una herramienta de acceso web
        Dim HTMLDocumento As New MSHTML.HTMLDocument
        HTMLDocumento.body.innerHTML = .responseText
    End With
    'pasamos el contenido a una funcionalidad XML
    'que identificará nodos, elementos, etc..
    inDoc.LoadXML (HTMLDocumento.body.innerHTML)
    Set nd = XMLFinal.importNode(inDoc.DocumentElement, True)
    rdo.appendChild nd

    archivoXML = Dir
Wend


'con el XML compuesto, procedemos a crear un nuevo XML global/consolidado
Dim sNombreficheroFinal As String
sNombreficheroFinal = "F:\excelforo\XML_test\Consolidado2009-2021.xml"

'Cerramos cualquier fichero de texto abierto
Close
'conseguimos el siguiente número de fichero libre
Dim numArchivoDestino As Long
numArchivoDestino = FreeFile

' escribimos el texto en el fichero
Open sNombreficheroFinal For Output As #numArchivoDestino
Print #numArchivoDestino, XMLFinal.XML
'y lo cerramos
Close #numArchivoDestino

Set XMLSolicitud = Nothing
Set nd = Nothing
Set rdo = Nothing
End Sub

El resultado es un único fichero .xml que contiene toda la información de los .xml de nuestra carpeta:
VBA: Trabajando con XML


Podrías preguntarte.. ¿por qué anexar los distintos ficheros .xml?... el motivo es que a la hora de trabajar con ellos desde Power Query, el proceso es más rápido y ágil ;-)

El siguiente proceso trata de cómo importar un fichero .xml en una hoja de Excel... pero sin traerse el mapa XML consigo!!.
Para ello insertamos un nuevo procedimiento Sub en un módulo estándar:
Sub ImportarXMLaExcel()
Dim xDoc As MSXML2.DOMDocument60
Dim xResult As MSXML2.IXMLDOMNode
Dim xEntry As MSXML2.IXMLDOMNode
Dim xChild As MSXML2.IXMLDOMNode
Dim xTag As MSXML2.IXMLDOMNode

Dim Col As Integer, Fila As Integer

Set xDoc = New MSXML2.DOMDocument60
xDoc.async = False
xDoc.validateOnParse = False
'recuperamos el fichero .xml resultante del anexado anterior
xDoc.Load ("F:\excelforo\XML_test\Consolidado2009-2021.xml")

Set xResult = xDoc.DocumentElement
Set xEntry = xResult.FirstChild

Col = 1: Fila = 1
'recorremos los niveles distintos de nuestros nodos
'en nuestro ejemplo son tres niveles: tabla, fila, etiquetas (fecha, pais, producto, ....)
For Each xEntry In xResult.ChildNodes
    For Each xChild In xEntry.ChildNodes
        Col = 1
        For Each xTag In xChild.ChildNodes
            'trasladamos el dato a la hoja 3
            If xTag.nodeName = "fecha" Then
                Sheets("Hoja3").Cells(Fila, Col).Value = CDate(xTag.Text)
            ElseIf IsNumeric(xTag.Text) = True Then
                Sheets("Hoja3").Cells(Fila, Col).Value = CDbl(xTag.Text)
            Else
                Sheets("Hoja3").Cells(Fila, Col).Value = xTag.Text
            End If
            Col = Col + 1
        Next xTag
        Fila = Fila + 1
    Next xChild
Next xEntry

End Sub

Podemos ver el resultado cargado en la hoja...
VBA: Trabajando con XML


Y finalmente toca obtener el mapa XML de un fichero.
En un nuevo módulo estándar añadimos el siguiente procedimiento.
Sub MAPS_XML()
Dim strMyXML As String
'ruta del fichero .xml
strMyXML = "F:\excelforo\XML_test\Consolidado2009-2021.xml"

'añadimos el mapa al fichero!!
'lo interesante es que el texto ppodrá ser guardado en un fichero .xsd (mapas de XML)
Dim myMap As XmlMap
Set myMap = ThisWorkbook.XmlMaps.Add(strMyXML)

Application.DisplayAlerts = True

Dim myXSD As String
'obtenemos la cadena del mapa en formato .xsd
myXSD = ThisWorkbook.XmlMaps(1).Schemas(1).XML

'devolvemmos los datos a la ventana de inmediato
Debug.Print myXSD
'devolvemmos los datos a la hoja
Sheets("Hoja2").Range("A1").Value = myXSD

'acabamos borrando el mapa, para no cargar el fichero innecesariamente
myMap.Delete
Set myMap = Nothing
End Sub

Y terminamos viendo el resultado:
VBA: Trabajando con XML