Macro con subtotales con número de cliente

[Benito Bartolomé]

Buenos días a todos;

-Una pequeña ayudita si es posible.

-Adjunto una macro que en su día amablemente me ayudó a configurar Antoni.

Como es habitual en él funciona de maravilla.

He querido si es posible ir un poco mas lejos y es que en el momento que calcular el subtotal en dicha línea me indique el número de cuenta.

Adjunto marco e imagen del resultado.

Gracia como siempre por vuestra ayuda y buen finde.

MSubtotales.xlsm

[Antoni]

Prueba el adjunto.

MSubtotales.xlsm

[Benito Bartolomé]

Bo día Antoni;

Estuve cerca cuando lo intentaba pero me faltó el ".Range", no quería pero voy tener que comprar??.

Comentar también que cometí un error en la macro, hay que cambiar "x = 4" por "x = 2".

También he cambiado una cosita a ver que te parece.

Para no estar obligado a tener siempre en la columna "B" el campo "Cuenta" lo he cambiado por el código que inserto, a ver que te parece.

Para retamar bo día inda que chova que seguro que ahí na capital seguro que tamén o esta facendo.

Por certo e para bromear un pouco e eu prefiro o Celta inda que sexa de Nigrán .

Sub CalculoSubtotales()
Dim Op As Range, OpCol As String
Dim Im As Range, ImCol As String
Dim vCuenta As Range, vCuentaCol As String
Dim Total As Double, Subtotal As Double

Application.ScreenUpdating = False
With Sheets("InformeCobros")
   Set Op = .Rows(1).Find("Op.")         'Op. en cualquier columna
   Set Im = .Rows(1).Find("Importe")     'Importe en cualquier columna
   Set vCuenta = .Rows(1).Find("Cuenta") 'Cuenta en cualquier columna
   
   OpCol = Split(Op.Address, "$")(1)
   ImCol = Split(Im.Address, "$")(1)
   vCuentaCol = Split(vCuenta.Address, "$")(1)
   
   For x = .Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      If UCase(.Range("A" & x)) Like "*TOTAL*" Then .Rows(x).Delete
   Next
   filas = .Range("A" & Rows.Count).End(xlUp).Row
   Total = WorksheetFunction.Sum(.Range(Im.Offset(1), Im.End(xlDown)))
   .Range(.Range("A2"), Op.End(xlDown)).Sort key1:=Op, key2:=[A2]
   x = 2
   Do: Do
         Subtotal = Subtotal + .Range(ImCol & x)
         x = x + 1
       Loop Until .Range(OpCol & x) <> .Range(OpCol & x - 1)
      .Rows(x).Insert
      '.Range("A" & x) = "Subtotal cliente: " & .Range("B" & x - 1)       'Columna fija
      .Range("A" & x) = "Subtotal cliente: " & .Range(vCuentaCol & x - 1) 'Columna variable
      .Range(ImCol & x) = Subtotal
      Subtotal = 0
      x = x + 1
   Loop Until .Range(OpCol & x) = ""
   .Range("A" & x) = "Total"
   .Range(ImCol & x) = Total
End With
End Sub