Saltar al contenido

Cargar 3 ListBox con condiciones desde una Hoja Excel al hacer ENTER

publicado

Hola Amigos y Amigas, necesito que me ayuden con este planteamiento. Necesito cargar desde una Hoja de Excel a tres ListBox todos los registros de la Cuenta que la Hoja Resumen Crat-Cli encuentre en la Hoja CartolaCli (Cuenta, Razón Social, Vencimiento, Monto o Importe), El evento debe suceder al dar Enter “ONKEY” en la celda de la columna A donde está la cuenta en la Hoja Resumen Cart-Cli. La Cuenta y Razon Social encontrada debe cargar en el encabezado del Form1, el vencimiento y el importe de debe estar distribuido en tres ListBox según condición de Clase de Documento:

Factura (DF)

Nota Crédito (DN)

Transacción (DZ)

En el caso de Factura están separado la suma de su importe de acuerdo a la fecha de vencimiento.
-Si la deuda ya venció mayor a 30 días.
-Si la deuda ya venció entre 1 y 30 días.

 

El inconveniente que tengo es que no me está cargando los registros al hacer Enter en la Columna A:A  de la Hoja (“Resumen Cart-Cli”)

Como el archivo es muy pesado escribo el código que se está trabajando.

 

Esto esta en un modulo:

Sub MontoFechVencimiento()
Dim Cuenta As Variant
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = Worksheets("Cartola Cli")

Filas = WS1.Range("G1").CurrentRegion.Rows.Count
Cuenta = Intersect(Target, Range("A:A")).Value
Mayor_Mes = 0
Menor_Mes = 0
NC_Total = 0
Transacc_Total = 0
For i = 2 To Filas


      If UCase(WS1.Cells(i, 7).Value) Like Cuenta Then
      
      If UCase(WS1.Cells(i, 1).Value) Like "DF" Then
         UserForm1.Fact1.AddItem WS1.Cells(i, 4) 'Vencimiento
         UserForm1.Fact1.List(UserForm1.Fact1.ListCount - 1, 1) = WS1.Cells(i, 5) 'Monto
         UserForm1.Cuenta.Caption = WS1.Cells(i, 7) 'Cuenta
         UserForm1.RazonSocial.Caption = WS1.Cells(i, ? 'Razon Social
         If LCase(WS1.Cells(i, 10).Value) Like "0 a 30" Then
            Menor_Mes = Menor_Mes + WS1.Cells(i, 5).Value
            ElseIf WS1.Cells(i, 9).Value > 30 Then
                   Mayor_Mes = Mayor_Mes + WS1.Cells(i, 5).Value
         End If
         
        ElseIf UCase(WS1.Cells(i, 1).Value) Like "DN" Then
           UserForm1.NotaCredit.AddItem WS1.Cells(i, 4) 'Vencimiento
           UserForm1.NotaCredit.List(UserForm1.NotaCredit.ListCount - 1, 1) = WS1.Cells(i, 5) 'Monto
           UserForm1.Cuenta.Caption = WS1.Cells(i, 7) 'Cuenta
           UserForm1.RazonSocial.Caption = WS1.Cells(i, ? 'Razon Social
           NC_Total = NC_Total + WS1.Cells(i, 5).Value
           
          ElseIf UCase(WS1.Cells(i, 1).Value) Like "DZ" Or UCase(WS1.Cells(i, 1).Value) Like "AB" Or _
             UCase(WS1.Cells(i, 1).Value) Like "DD" Then
             UserForm1.Transacc.AddItem WS1.Cells(i, 4) 'Vencimiento
             UserForm1.Transacc.List(UserForm1.Transacc.ListCount - 1, 1) = WS1.Cells(i, 5) 'Monto
             UserForm1.Cuenta.Caption = WS1.Cells(i, 7) 'Cuenta
             UserForm1.RazonSocial.Caption = WS1.Cells(i, ? 'Razon Social
             Transacc_Total = Transacc_Total + WS1.Cells(i, 5).Value
    End If
    End If
    UserForm1.Menor_Mes.Text = Menor_Mes
    UserForm1.Mayor_Mes.Text = Mayor_Mes
    UserForm1.NC_Total.Text = NC_Total
    UserForm1.Transacc_Total.Text = Transacc_Total
    UserForm1.Fact_Total.Text = Menor_Mes + Mayor_Mes
    UserForm1.Monto_Total.Text = Menor_Mes + Mayor_Mes + NC_Total + Transacc_Total
Next i
End Sub

 

 

Esto esta en la Hoja Resumen Cart-Cli

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.FormulaR1C1 = "Cuenta" Then
   UserForm1.Show
   UserForm1.Fact1.Clear
   UserForm1.NotaCredit.Clear
   UserForm1.Transacc.Clear
   UserForm1.Menor_Mes.Text = Empty
   UserForm1.Mayor_Mes.Text = Empty
   UserForm1.NC_Total.Text = Empty
   UserForm1.Transacc_Total.Text = Empty
   UserForm1.Fact_Total.Text = Empty
   UserForm1.Monto_Total.Text = Empty
End If
If Not Intersect(Target, Range("A:A")) Is Nothing And Selection.Count = 1 And _
       ActiveCell.FormulaR1C1 <> "Cuenta" Then
       Application.OnKey "{ENTER}", "MontoFechVencimiento"
End If

End Sub

 

 

 

 

 

 

 

Featured Replies

publicado

Buenas, es complicado que alguien te ayude sin el archivo, ya que por lo que muestras hay un formulario con varios componentes y no creo que nadie pierda el tiempo en generar el archivo.

saludos

 

publicado
  • Autor

El Archivo es muy pesado.

Lamentablemente este foro para los archivos tiene acotado los kb, cuando el mínimo debería ser 1mg

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.