MaxArrSiConjunto

Esta función nos permite obtener el valor máximo de un rango con distintas condiciones. Sería algo parecido a la función sumar.si.conjunto, pero el resultado final es el valor máximo del rango. La particularidad de esta función es que te permite acceder al valor máximo (primer máximo, segundo máximo, tercer máximo)

=MaxArrSiConjunto([1];[2];[3′];[4′];[3”];[4”]…..)

[1]: Rango de valores que queremos encontrar el valor máximo

[2]: Posición del array (1: pirmer máximo, 2: segundo máximo….)

[3′]: Rango que tienen las condiciones

[4′]: Condición

[3”]: Segundo Rango que tienen las condiciones

[4”]: Segunda Condición

…… Tantos rangos y condiciones como quieras

Public Function MaxArrSiConjunto(Unico As Range, Pos As Integer, ParamArray prms() As Variant) As Variant
    '=MaxSiConjunto([1];[2'];[3'];[2''];[3''].....)
       '[1]: Rango de valores que queremos contar sin repetidos
       '[2]: Posición del array (1: pirmer máximo, 2: segundo máximo....)
       '[3']: Rango que tienen las condiciones
       '[4']: Condición
       '[5'']: Segundo Rango que tienen las condiciones
       '[6'']: Segunda Condición
       '...... Tantos rangos y condiciones como quieras
 
       'abelorteu@informaticaea.com
    Dim filaInit As Long
    Dim filaFinal As Long
    Dim Condicion As Boolean
    Dim i As Integer
 
    Dim col As New Collection
    Dim colSort As New Collection
    Dim varElement As Variant
 
    filaInit = Unico.Row
    filaFinal = filaInit + Unico.Count - 1
 
    Dim x As Variant
    x = (UBound(prms) + 1) / 2
    If (x = Int(x)) Then
        On Error Resume Next
        For i = 1 To filaFinal - filaInit + 1
            Condicion = True
            For a = 1 To x
                If (UCase(Trim(prms(a * 2 - 2)(i))) <> UCase(Trim(prms(a * 2 - 1)))) Then
                    Condicion = False
                End If
            Next a
            If (Condicion) Then
                col.Add Item:=CStr(CLng(Unico(i))), Key:=CStr(CLng(Unico(i)))
            End If
        Next i
 
        Set colSort = fnVarBubbleSort(col, False)
 
        i = 1
        MaxArrSiConjunto = "#NoValue"
        For Each varElement In colSort
            If i = Pos Then
                'Debug.Print varElement
                MaxArrSiConjunto = CLng(varElement)
            End If
            i = i + 1
        Next varElement
    Else
       MaxArrSiConjunto = "#ERROR"
    End If
End Function
 
Public Function fnVarBubbleSort(ByRef colInput As Collection, Optional bAsc = True) As Collection
 
    Dim varTemp                 As Variant
    Dim lngCounter              As Long
    Dim lngCounter2             As Long
 
    For lngCounter = 1 To colInput.Count - 1
        For lngCounter2 = lngCounter + 1 To colInput.Count
            Select Case bAsc
            Case True:
                If colInput(lngCounter) > colInput(lngCounter2) Then
                    varTemp = colInput(lngCounter2)
                    colInput.Remove lngCounter2
                    colInput.Add varTemp, varTemp, lngCounter
                End If
 
            Case False:
                If colInput(lngCounter) < colInput(lngCounter2) Then
                    varTemp = colInput(lngCounter2)
                    colInput.Remove lngCounter2
                    colInput.Add varTemp, varTemp, lngCounter
                End If
            End Select
        Next lngCounter2
    Next lngCounter
 
    Set fnVarBubbleSort = colInput
 
End Function

MaxSiConjunto

Esta función nos permite obtener el valor máximo de un rango con distintas condiciones. Sería algo parecido a la función sumar.si.conjunto, pero el resultado final es el valor máximo del rango.

=MaxSiConjunto([1];[2′];[3′];[2”];[3”]…..)

[1]: Rango de valores que queremos encontrar el valor máximo/p>

[2′]: Rango que tienen las condiciones

[3′]: Condición

[2”]: Segundo Rango que tienen las condiciones

[3”]: Segunda Condición ‘…… Tantos rangos y condiciones como quieras

Public Function MaxSiConjunto(ValMax As Range, ParamArray prms() As Variant) As Variant
 
    '=MaxSiConjunto([1];[2'];[3'];[2''];[3''].....)
       '[1]: Rango de valores que queremos encontrar el valor máximo
       '[2']: Rango que tienen las condiciones
       '[3']: Condición
       '[2'']: Segundo Rango que tienen las condiciones
       '[3'']: Segunda Condición
       '...... Tantos rangos y condiciones como quieras
 
       'abelorteu@informaticaea.com
 
    Dim filaInit As Long
    Dim filaFinal As Long
    Dim Condicion As Boolean
    Dim MAX As Variant
 
 
    filaInit = ValMax.Row
    filaFinal = filaInit + ValMax.Count - 1
    Dim x As Variant
    x = (UBound(prms) + 1) / 2
    MAX = "#ERROR"
    If (x = Int(x)) Then
        On Error Resume Next
        MAX = "#ERROR"
        For i = 1 To filaFinal - filaInit + 1
            Condicion = True
            For a = 1 To x
                If (UCase(Trim(prms(a * 2 - 2)(i))) <> UCase(Trim(prms(a * 2 - 1)))) Then
                    Condicion = False
                End If
            Next a
            If Condicion Then
                If (CLng(ValMax(i)) > CLng(MAX)) Then
                    MAX = CLng(ValMax(i))
                End If
            End If
        Next i
    End If
    MaxSiConjunto = MAX
End Function

MinSiConjunto

Esta función nos permite obtener el valor mínimo de un rango con distintas condiciones. Sería algo parecido a la función sumar.si.conjunto, pero el resultado final es el valor mínimo del rango.

=MinSiConjunto([1];[2′];[3′];[2”];[3”]…..)

[1]: Rango de valores que queremos encontrar el valor mínimo

[2′]: Rango que tienen las condiciones

[3′]: Condición

[2”]: Segundo Rango que tienen las condiciones

[3”]: Segunda Condición ‘…… Tantos rangos y condiciones como quieras

Public Function MinSiConjunto(ValMin As Range, ParamArray prms() As Variant) As Variant
    '=MinSiConjunto([1];[2'];[3'];[2''];[3''].....)
       '[1]: Rango de valores que queremos encontrar el valor minimo
       '[2']: Rango que tienen las condiciones
       '[3']: Condición
       '[2'']: Segundo Rango que tienen las condiciones
       '[3'']: Segunda Condición
       '...... Tantos rangos y condiciones como quieras
 
       'abelorteu@informaticaea.com
 
 
    Dim filaInit As Long
    Dim filaFinal As Long
    Dim Condicion As Boolean
    Dim MIN As Variant
 
 
    filaInit = ValMin.Row
    filaFinal = filaInit + ValMin.Count - 1
    Dim x As Variant
    x = (UBound(prms) + 1) / 2
    MIN = "#ERROR"
    If (x = Int(x)) Then
        On Error Resume Next
        MIN = "#ERROR"
        For i = 1 To filaFinal - filaInit + 1
            Condicion = True
            For a = 1 To x
                If (UCase(Trim(prms(a * 2 - 2)(i))) <> UCase(Trim(prms(a * 2 - 1)))) Then
                    Condicion = False
                End If
            Next a
            If Condicion Then
                If (CLng(ValMin(i)) < CLng(MIN)) Then
                    MIN = CLng(ValMin(i))
                End If
            End If
        Next i
    End If
    MinSiConjunto = MIN
End Function

Collection VBA

Los tipos de datos Collection en algunos libros de informática se denominan diccionario que es una tabla de elementos en la que puedes buscar una entrada usando una clave.

En Visual Basic los datos Collection. Presentan las siguientes características:

  • Habilita almacenar elementos relacionados
  • Proporciona los métodos Add, Remove, Item y la propiedad Count
Dim dict As New Collection
 
dict.Add Item:="Valor 1", Key:="Key 1"
dict.Add Item:="Valor 2", Key:="Key 2"
dict.Add Item:="Valor 3", Key:="Key 3"
dict.Add Item:="Valor 4", Key:="Key 4"

Si queremos acceder a un elemento a partir de la clave

Debug.Print (dict("Key 2"))
'Valor 2

Si queremos listar toda la matriz

Dim K As Variant
For Each K In dict.Keys
    debug.print "Key: " &amp; K , "Value: " &amp; dict.Item(K)
Next

Pegar imagen en una celda

Para pegar una imagen que tenemos en el porta papeles en una celda de Excel seleccionada, utilizaremos la siguiente macro:

Sub PegarFoto()
    ActiveSheet.Paste 'Pegamos del portapapeles
    ActiveSheet.Select
    With Selection
        .ShapeRange.LockAspectRatio = msoFalse
        .ShapeRange.Height = 175 'Alto de la imagen
        .ShapeRange.Width = 205 'Ancho de la imagen
        .ShapeRange.Left = .ShapeRange.Left + 1 'Añadimos 1 para que se vea la línea divisoria de la celda (izquierda)
        .ShapeRange.Top = .ShapeRange.Top + 1 'Añadimos 1 para que se vea la línea divisoria de la celda (superior)
    End With
End Sub

Obtener la letra de una columna en Excel

Esta fórmula nos permite obtener el valor de la columna:

=SUSTITUIR(SUSTITUIR(DIRECCION(FILA();COLUMNA());"$";"");FILA();"")

Explicación de las formulas empleadas:

  • SUSTITUIR: con esta reemplazamos, realmente eliminamos, caracteres que nos estorban para nuestro objetivo
  • DIRECCION: definimos la celda a evaluar, para obtener de ella la letra de su columna.
  • FILA y COLUMNA: la base de toda la propuesta, con éstas obtenemos una numeración para definir una celda.

Tabla de traducción de fórmulas Excel español vs english

Español Inglés
ABRIR.ARCHIVO OPEN.DIALOG
ABRIRA FOPEN
ABS ABS
ACOS ACOS
ACOSH ACOSH
AGREGAR.BARRA ADD.BAR
AGREGAR.BARRA.HERRAMIENTAS ADD.TOOLBAR
AGREGAR.COMANDO ADD.COMMAND
AGREGAR.MENU ADD.MENU
AGRUPAR GROUP
AHORA NOW
ALEATORIO RAND
AÑO YEAR
APL.TITULO APP.TITLE
ARCHIVOS FILES
AREAS AREAS
ARGUMENTO ARGUMENT
ASC ASC
ASENO ASIN
ASENOH ASINH
ATAN ATAN
ATAN2 ATAN2
ATANH ATANH
AYUDA HELP
BDCONTAR DCOUNT
BDCONTARA DCOUNTA
BDDESVEST DSTDEV
BDDESVESTP DSTDEVP
BDEXTRAER DGET
BDMAX DMAX
BDMIN DMIN
BDPRODUCTO DPRODUCT
BDPROMEDIO DAVERAGE
BDSUMA DSUM
BDVAR DVAR
BDVARP DVARP
BINOM.CRIT CRITBINOM
BUSCAR LOOKUP
BUSCARH HLOOKUP
BUSCARV VLOOKUP
CADENA.FECHA DATESTRING
CADENA.NUMERO NUMBERSTRING
CAMBIAR.NOMBRE.COMANDO RENAME.COMMAND
CANCELAR.TECLA CANCEL.KEY
CARACTER CHAR
CELDA CELL
CELDA.ACTIVA ACTIVE.CELL
CERRARA FCLOSE
CODIGO CODE
COEF.DE.CORREL CORREL
COEFICIENTE.ASIMETRIA SKEW
COEFICIENTE.R2 RSQ
COINCIDIR MATCH
COLUMNA COLUMN
COLUMNAS COLUMNS
COMBINAT COMBIN
CONCATENAR CONCATENATE
CONTAR COUNT
CONTAR.BLANCO COUNTBLANK
CONTAR.SI COUNTIF
CONTARA COUNTA
COS COS
COSH COSH
COVAR COVAR
CREAR.OBJETO CREATE.OBJECT
CRECIMIENTO GROWTH
CUADRO.DE.DIALOGO DIALOG.BOX
CUADRO.DE.TEXTO TEXT.BOX
CUARTIL QUARTILE
CURTOSIS KURT
DB DB
DBCS DBCS
DDB DDB
DECIMAL FIXED
DERECHA RIGHT
DERECHAB RIGHTB
DESREF OFFSET
DESREGISTRAR UNREGISTER
DESVEST STDEV
DESVESTP STDEVP
DESVIA2 DEVSQ
DESVPROM AVEDEV
DETENER HALT
DIA DAY
DIAS360 DAYS360
DIASEM WEEKDAY
DIRECCION ADDRESS
DIRECTORIO DIRECTORY
DIST.WEIBULL WEIBULL
DISTR.BETA BETADIST
DISTR.BETA.INV BETAINV
DISTR.BINOM BINOMDIST
DISTR.CHI CHIDIST
DISTR.EXP EXPONDIST
DISTR.F FDIST
DISTR.F.INV FINV
DISTR.GAMMA GAMMADIST
DISTR.GAMMA.INV GAMMAINV
DISTR.HIPERGEOM HYPGEOMDIST
DISTR.LOG.INV LOGINV
DISTR.LOG.NORM LOGNORMDIST
DISTR.NORM NORMDIST
DISTR.NORM.ESTAND NORMSDIST
DISTR.NORM.ESTAND.INV NORMSINV
DISTR.NORM.INV NORMINV
DISTR.T TDIST
DISTR.T.INV TINV
DOCUMENTOS DOCUMENTS
DVS VDB
ECHO ECHO
EJEC EXEC
EJECUTA EXECUTE
ELEGIR CHOOSE
ELIMINAR.BARRA DELETE.BAR
ELIMINAR.BARRA.HERRAMIENTAS DELETE.TOOLBAR
ELIMINAR.COMANDO DELETE.COMMAND
ELIMINAR.MENU DELETE.MENU
ENCONTRAR FIND
ENCONTRARB FINDB
ENTERO INT
ERROR ERROR
ERROR.TIPICO.XY STEYX
ESBLANCO ISBLANK
ESCENARIO.INDICAR SCENARIO.GET
ESCRIBIRA FWRITE
ESCRIBIRALN FWRITELN
ESERR ISERR
ESERROR ISERROR
ESLOGICO ISLOGICAL
ESNOD ISNA
ESNOTEXTO ISNONTEXT
ESNUMERO ISNUMBER
ESPACIOS TRIM
ESREF ISREF
ESTABLECER.NOMBRE SET.NAME
ESTABLECER.VALOR SET.VALUE
ESTEXTO ISTEXT
ESTIMACION.LINEAL LINEST
ESTIMACION.LOGARITMICA LOGEST
EVALUAR EVALUATE
EXP EXP
EXTRAE MIDB
EXTRAE MID
FACT FACT
FECHA DATE
FECHANUMERO DATEVALUE
FILA ROW
FILAS ROWS
FISHER FISHER
FORMULA.CONVERTIR FORMULA.CONVERT
FRECUENCIA FREQUENCY
GAMMA.LN GAMMALN
GET.MOVIE GET.MOVIE
GRADOS DEGREES
GUARDAR.ARCHIVO SAVE.DIALOG
GUARDAR.BARRA.HERRAMIENTAS SAVE.TOOLBAR
HABILITAR.COMANDO ENABLE.COMMAND
HABILITAR.HERRAMIENTA ENABLE.TOOL
HALLAR SEARCH
HALLARB SEARCHB
HORA HOUR
HORANUMERO TIMEVALUE
HOY TODAY
ID.REGISTRO REGISTER.ID
IGUAL EXACT
INDICAR.AREA.DE.TRABAJO GET.WORKSPACE
INDICAR.BARRA GET.BAR
INDICAR.BARRA.HERRAMIENTAS GET.TOOLBAR
INDICAR.CAMPO.TABLA.DI GET.PIVOT.FIELD
INDICAR.CELDA GET.CELL
INDICAR.DEF GET.DEF
INDICAR.DOCUMENTO GET.DOCUMENT
INDICAR.ELEMENTO.GRAFICO GET.CHART.ITEM
INDICAR.ELEMENTO.TABLA.DI GET.PIVOT.ITEM
INDICAR.FORMULA GET.FORMULA
INDICAR.HERRAMIENTA GET.TOOL
INDICAR.INFO.VINCULO GET.LINK.INFO
INDICAR.LIBRO GET.WORKBOOK
INDICAR.NOMBRE GET.NAME
INDICAR.NOTAS GET.NOTE
INDICAR.OBJETO GET.OBJECT
INDICAR.TABLA.DINAMICA GET.PIVOT.TABLE
INDICAR.VENTANA GET.WINDOW
INDICE INDEX
INDIRECTO INDIRECT
INFO INFO
INICIAR INITIATE
INT.PAGO.DIR ISPMT
INTERSECCION INTERCEPT
INTERVALO.CONFIANZA CONFIDENCE
INTRODUCIR INPUT
IR.A GOTO
IZQUIERDA LEFT
IZQUIERDAB LEFTB
JERARQUIA RANK
K.ESIMO.MAYOR LARGE
K.ESIMO.MENOR SMALL
LARGO LEN
LARGOB LENB
LEERA FREAD
LEERALN FREADLN
LIMPIAR CLEAN
LN LN
LOG LOG
LOG10 LOG10
LLAMADOR CALLER
LLAMAR CALL
MARCAR.COMANDO CHECK.COMMAND
MAX MAX
MAYUSC UPPER
MDETERM MDETERM
MEDIA.ACOTADA TRIMMEAN
MEDIA.ARMO HARMEAN
MEDIA.GEOM GEOMEAN
MEDIANA MEDIAN
MES MONTH
MIN MIN
MINUSC LOWER
MINUTO MINUTE
MINVERSA MINVERSE
MMULT MMULT
MODA MODE
MONEDA DOLLAR
MOSTRAR.BARRA SHOW.BAR
MOVIE.COMMAND MOVIE.COMMAND
MULTIPLO.INFERIOR FLOOR
MULTIPLO.SUPERIOR CEILING
N N
NEGBINOMDIST NEGBINOMDIST
NO NOT
NOD NA
NOMBRES NAMES
NOMPROPIO PROPER
NORMALIZACION STANDARDIZE
NOTA NOTE
NPER NPER
NSHORA TIME
NUMERO.ROMANO ROMAN
O OR
OPCIONES.INDICAR.LISTAS OPTIONS.LISTS.GET
PAGO PMT
PAGOINT IPMT
PAGOPRIN PPMT
PASO.A.PASO STEP
PAUSA PAUSE
PEARSON PEARSON
PENDIENTE SLOPE
PERCENTIL PERCENTILE
PERMUTACIONES PERMUT
PERSONALIZAR.DESHACER CUSTOM.UNDO
PERSONALIZAR.REPETIR CUSTOM.REPEAT
PI PI
POISSON POISSON
POSICIONA FPOS
POTENCIA POWER
PRESIONAR.HERRAMIENTA PRESS.TOOL
PROBABILIDAD PROB
PRODUCTO PRODUCT
PROMEDIO AVERAGE
PRONOSTICO FORECAST
PRUEBA.CHI CHITEST
PRUEBA.CHI.INV CHIINV
PRUEBA.F FTEST
PRUEBA.FISHER.INV FISHERINV
PRUEBA.T TTEST
PRUEBA.Z ZTEST
RADIANES RADIANS
RAIZ SQRT
RANGO.PERCENTIL PERCENTRANK
REANUDAR RESUME
REDONDEA.IMPAR ODD
REDONDEA.PAR EVEN
REDONDEAR ROUND
REDONDEAR.MAS ROUNDUP
REDONDEAR.MENOS ROUNDDOWN
REEMPLAZAR REPLACE
REEMPLAZARB REPLACEB
REFABS ABSREF
REFREL RELREF
REFTEXTO REFTEXT
REGISTRAR REGISTER
REINICIAR RESTART
REPETIR REPT
RESIDUO MOD
RESTABLECER.BARRA RESET.TOOLBAR
RESULTADO RESULT
REVISION.ORTOGRAFICA SPELLING.CHECK
SEGUNDO SECOND
SELECCION SELECTION
SENO SIN
SENOH SINH
SERIES SERIES
SI IF
SIFECHA DATEDIF
SIGNO SIGN
SLN SLN
SOLICITAR REQUEST
SUBTOTALES SUBTOTAL
SUMA SUM
SUMA.CUADRADOS SUMSQ
SUMAPRODUCTO SUMPRODUCT
SUMAR.SI SUMIF
SUMAX2MASY2 SUMX2PY2
SUMAX2MENOSY2 SUMX2MY2
SUMAXMENOSY2 SUMXMY2
SUSTITUIR SUBSTITUTE
SYD SYD
T T
TABLA.DI.ADICIONAR.DATOS PIVOT.ADD.DATA
TAMAÑOA FSIZE
TAN TAN
TANH TANH
TASA RATE
TENDENCIA TREND
TERMINAR TERMINATE
TEXTO TEXT
TEXTOREF TEXTREF
TIPO TYPE
TIPO.DE.ERROR ERROR.TYPE
TIR IRR
TIRM MIRR
TRANSFERIR POKE
TRANSPONER TRANSPOSE
TRUNCAR TRUNC
ULTIMO.ERROR LAST.ERROR
USDOLLAR USDOLLAR
VA PV
VALOR VALUE
VALREF DEREF
VAR VAR
VARP VARP
VENTANA.TITULO WINDOW.TITLE
VENTANAS WINDOWS
VF FV
VINCULOS LINKS
VNA NPV
VOLATIL VOLATILE
Y AND
FALSO FALSE
VERDADERO TRUE

 

Contar único VBA

Esta función permite contar valores únicos de un rango, con una condición de otro rango. Sería algo parecido a la funcion contar.si, pero el resultado final son valores únicos.

=ContarUnico([1];[2];[3])

[1]: Rango de valores que queremos contar sin repetidos

[2]: Rango que tienen las condiciones

[3]: Condición

Captura

Public Function ContarUnico(rng As Range) As Long
   'abelorteu@informaticaea.com
 
    Dim col As New Collection
    Dim cel As Range
    On Error Resume Next
    For Each cel In rng
        col.Add Item:=CStr(cel.Value), Key:=CStr(cel.Value)
    Next cel
    ContarUnico = col.Count
End Function
 
Public Function ContarUnicoSi(Unico As Range, Range1 As Range, Valor As Variant) As Long
       '=ContarUnicoSi([1];[2];[3])
       '[1]: Rango de valores que queremos contar sin repetidos
       '[2]: Rango que tienen las condiciones
       '[3]: Condición
 
       'abelorteu@informaticaea.com
    Dim filaInit As Long
    Dim filaFinal As Long
 
    Dim col As New Collection
 
    filaInit = Range1.Row
    filaFinal = filaInit + Range1.Rows.Count - 1
 
    On Error Resume Next
    For i = 1 To filaFinal - filaInit + 1
        If (UCase(Trim(Range1(i).Value)) = UCase(Trim(Valor))) Then
            col.Add Item:=CStr(Unico(i).Value), Key:=CStr(Unico(i).Value)
        End If
    Next
 
    If (arrDic.Count = 0) Then
        ContarUnicoSi = col.Count
    Else
        ContarUnicoSi = col.Count - 1
    End If
End Function
 
Public Function ContarUnicoSiConjunto(Unico As Range, ParamArray prms() As Variant) As Variant
    '=ContarUnicoSiConjunto([1];[2'];[3'];[2''];[3''].....)
       '[1]: Rango de valores que queremos contar sin repetidos
       '[2']: Rango que tienen las condiciones
       '[3']: Condición
       '[2'']: Segundo Rango que tienen las condiciones
       '[3'']: Segunda Condición
       '...... Tantos rangos y condiciones como quieras
 
       'abelorteu@informaticaea.com
    Dim filaInit As Long
    Dim filaFinal As Long
    Dim Condicion As Boolean
 
    Dim col As New Collection
 
    filaInit = Unico.Row
    filaFinal = filaInit + Unico.Count - 1
    Dim x As Variant
    x = (UBound(prms) + 1) / 2
    If (x = Int(x)) Then
        On Error Resume Next
        For i = 1 To filaFinal - filaInit + 1
            Condicion = True
            For a = 1 To x
                If (UCase(Trim(prms(a * 2 - 2)(i))) <> UCase(Trim(prms(a * 2 - 1)))) Then
                    Condicion = False
                End If
            Next a
            If (Condicion) Then
                col.Add Item:=CStr(Unico(i)), Key:=CStr(Unico(i))
                Debug.Print Unico(i)
            End If
        Next i
 
        If (arrDic.Count = 0) Then
            ContarUnicoSiConjunto = col.Count
        Else
            ContarUnicoSiConjunto = col.Count - 1
        End If
    Else
       ContarUnicoSiConjunto = "#ERROR"
    End If
End Function

Funciones para trabajar con archivos

Funciones para trabajar con archivos

Sub MostrarRutaArchivo()
'Mostramos la ruta del archivo actual.
MsgBox ThisWorkbook.Path
 
End Sub
Sub CrearDirectorio()
'Creamos una caroeta en el escritorio
MkDir "C:\Users\Usuario\Desktop\NombreNuevaCarpeta"
 
End Sub
Sub CopiarArchivo()
'Copiamos archivo a la carpeta Nuevo
FileCopy "C:\Users\Usuario\Desktop\Archivo.xlsx", "C:\Users\Usuario\Desktop\Nuevo\Archivo.xlsx"
 
End Sub
Sub EliminarArchivo()
'Eliminamos archivo
Kill "C:\Users\Usuario\Desktop\archivo.xlsx"
 
End Sub
Sub RenombrarArchivo()
'Renombramos archivo
Name "C:\Users\Usuario\Desktop\archivo.xlsx" As "C:\Users\Usuario\Desktop\archivo2.xlsx"
 
End Sub
Sub MoverArchivo()
'Movemos archivo a la carpeta Nuevo
Name "C:\Users\Usuario\Desktop\archivo.xlsx" As "C:\Users\Usuario\Desktop\Nuevo\archivo.xlsx"
 
End Sub

Ordenar array VBA

Este script nos permite oredenar un array de manor a mayor en VBA

Sub BubbleSort(arr)
   ' Ordena de menor a mayor un array
   ' Call BubbleSort(MyArray)
  Dim strTemp As String
  Dim i As Long
  Dim j As Long
  Dim lngMin As Long
  Dim lngMax As Long
  lngMin = LBound(arr)
  lngMax = UBound(arr)
 
   For i = lngMin To lngMax - 1
    For j = i + 1 To lngMax
     If arr(i) &gt; arr(j) Then
       strTemp = arr(i)
       arr(i) = arr(j)
       arr(j) = strTemp
     End If
    Next j
   Next i
End Sub