Last active
July 4, 2024 20:57
-
-
Save Dalboz/34b8220d982218b3a6d046e2d52f471f to your computer and use it in GitHub Desktop.
Utils para mantener el fichero de spending y el fichero de carga
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Sub AddNewAccounts() | |
| ' Desactivar la actualización de pantalla y el cálculo automático para mejorar el rendimiento | |
| Application.ScreenUpdating = False | |
| Application.Calculation = xlCalculationManual | |
| Dim wsParam As Worksheet | |
| Dim ws As Worksheet | |
| Dim lastRow As Long | |
| ' Establecer la hoja "param" | |
| Set wsParam = ThisWorkbook.Sheets("param") | |
| lastRow = wsParam.Cells(wsParam.Rows.Count, 1).End(xlUp).Row | |
| ' Iterar sobre todas las hojas del libro | |
| For Each ws In ThisWorkbook.Worksheets | |
| ' Verificar si la hoja no es "param" ni "Base" ni "MD" | |
| If ws.Name <> "param" And ws.Name <> "Base" And ws.Name <> "MD" Then | |
| ' Iterar sobre las cuentas a ser procesadas | |
| For ixi = 2 To lastRow | |
| ' Leer los datos de la nueva cuenta desde la hoja "param" | |
| Dim cuentaReferencia As String | |
| Dim cuentaReferenciaDashboard As String | |
| Dim cuentaReferenciaDescription As String | |
| Dim nuevaCuenta As String | |
| Dim nuevaCuentaDashboard As String | |
| Dim nuevaCuentaDescription As String | |
| cuentaReferencia = wsParam.Cells(ixi, 1).Value | |
| cuentaReferenciaDashboard = wsParam.Cells(ixi, 2).Value | |
| cuentaReferenciaDescription = wsParam.Cells(ixi, 3).Value | |
| nuevaCuenta = wsParam.Cells(ixi, 4).Value | |
| nuevaCuentaDashboard = wsParam.Cells(ixi, 5).Value | |
| nuevaCuentaDescription = wsParam.Cells(ixi, 6).Value | |
| ' Procesar la inserción de la nueva cuenta en la hoja actual | |
| Application.StatusBar = ws.Name & ":" & ixi | |
| Call ProcessWorksheet(ws, cuentaReferencia, cuentaReferenciaDashboard, cuentaReferenciaDescription, nuevaCuenta, nuevaCuentaDashboard, nuevaCuentaDescription) | |
| Next ixi | |
| End If | |
| Next ws | |
| ' Restaurar las configuraciones originales | |
| MsgBox "Se han añadido las nuevas cuentas exitosamente." | |
| ThisWorkbook.Sheets("param").Activate | |
| ThisWorkbook.Sheets("param").Cells(1, 1).Activate | |
| Application.Calculation = xlCalculationAutomatic | |
| Application.ScreenUpdating = True | |
| Application.StatusBar = False | |
| End Sub | |
| Sub ProcessWorksheet(ws As Worksheet, cuentaReferencia As String, cuentaReferenciaDashboard As String, cuentaReferenciaDescription As String, nuevaCuenta As String, nuevaCuentaDashboard As String, nuevaCuentaDescription As String) | |
| Dim lastRowTest As Long | |
| Dim cuentaExistente As Boolean | |
| Dim k As Long | |
| ' Encontrar la última fila con datos en la hoja actual | |
| lastRowTest = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row | |
| ' Verificar si la nueva cuenta ya existe en la columna B | |
| cuentaExistente = False | |
| For k = 2 To lastRowTest ' Asumiendo que la fila 1 es el encabezado | |
| If InStr(1, ws.Cells(k, 2).Value, nuevaCuenta) > 0 Then | |
| cuentaExistente = True | |
| Exit For | |
| End If | |
| Next k | |
| ' Si la cuenta ya existe, omitir el procesamiento | |
| If cuentaExistente Then | |
| Application.StatusBar = "La cuenta " & nuevaCuenta & " ya existe en la hoja " & ws.Name & ". Se omite el procesamiento para esta hoja." | |
| Else | |
| Dim j As Long | |
| For j = lastRowTest To 2 Step -1 ' Asumiendo que la fila 2 es el encabezado | |
| Dim cuentaReferenciaTest As String | |
| cuentaReferenciaTest = ws.Cells(j, 2).Value ' Columna B (2da columna) | |
| ' Verificar si la celda en la columna B está vacía o contiene solo espacios en blanco | |
| If Trim(cuentaReferenciaTest) <> "" Then | |
| ' Extraer la parte numérica de cuentaReferenciaTest | |
| Dim cuentaReferenciaNumerica As String | |
| Dim splitResult As Variant | |
| splitResult = Split(cuentaReferenciaTest, "-") | |
| ' Verificar si la parte numérica es un número | |
| If UBound(splitResult) > 0 Then | |
| cuentaReferenciaNumerica = splitResult(1) | |
| If IsNumeric(cuentaReferenciaNumerica) Then | |
| If cuentaReferencia * 1 = cuentaReferenciaNumerica * 1 Then | |
| ' Insertar la nueva cuenta en la posición encontrada | |
| ws.Rows(j + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove | |
| ws.Rows(j).Copy Destination:=ws.Rows(j + 1) | |
| ws.Cells(j + 1, 1).Value = Replace(ws.Cells(j, 1).Value, ws.Cells(j + 1, 1), nuevaCuentaDashboard) | |
| ws.Cells(j + 1, 2).Value = Replace(ws.Cells(j, 2).Value, cuentaReferencia, nuevaCuenta) | |
| ws.Cells(j + 1, 3).Value = Replace(ws.Cells(j, 3).Value, ws.Cells(j, 3), nuevaCuentaDescription) | |
| ' Actualizar lastRowTest ya que se ha insertado una nueva fila | |
| lastRowTest = lastRowTest + 1 | |
| End If | |
| Else | |
| ' Si la parte numérica no es un número, omitir la fila y continuar con la siguiente | |
| Application.StatusBar = "La fila " & j & " de la hoja " & ws.Name & "no tiene una cuenta numérica válida. Se omite esta fila." | |
| End If | |
| End If | |
| End If | |
| Next j | |
| End If | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment