Visual Basic - Recorrer columnas a la izquierda para mi Macro

Life is soft - evento anual de software empresarial
   
Vista:
Imágen de perfil de Jvnto

Recorrer columnas a la izquierda para mi Macro

Publicado por Jvnto (9 intervenciones) el 02/11/2015 17:51:15
Estimados,

Logre hacer un código para poder agrupar mis datos, pero solo lo he conseguido realizar para la columna : "J"

Y lo que no he podido realizar es colocar un Activecell.offset, para que me identifique la columna anterior, y vuelva a correr la formula.

En caso haya una forma más abreviada para mi macro seria de gran ayuda.

Adjunto el archivo con la macro realizada.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Jvnto

Recorrer columnas a la izquierda para mi Macro

Publicado por Jvnto (9 intervenciones) el 03/11/2015 17:50:46
Logre escribir este código, donde me están corriendo correctamente las columnas, pero aún tengo algunas fallas técnicas, creo que es con la variable Boolean.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub AGRUPON()
Dim Inicio As Integer
Dim Final As Integer
Dim Auxiliar As Integer
Dim A, B As Integer
Dim FinDatos As Boolean
Dim TotalFilas As Double
Dim num As String
 
FinDatos = False
Auxiliar = 1
A = Auxiliar
Inicio = 1
num = 3
 
Range("F16").End(xlDown).Select
TotalFilas = ActiveCell.Row
 
 
'Range("J3806").Select
 
 
For Col = 0 To 11
For x = 1 To TotalFilas
 
Range("A1").Offset(0, Col).Value = num
num = num + 1
Letra = Letra_Columna(num)
 
For A = Inicio To TotalFilas
If Range(Letra & Trim(Str(A))).Value = "Resultado" Then
Inicio = A + 1
Exit For
End If
Next A
 
If Inicio = TotalFilas Then Exit Sub
 
For B = Inicio To TotalFilas
If Range(Letra & Trim(Str(B))).Interior.ColorIndex <> 42 Or Range(Letra & Trim(Str(B))).Borders.LineStyle <> 1 Then
If Range(Letra & Trim(Str(B))).Borders.LineStyle <> 1 Then FinDatos = True
Final = B - 1
Exit For
End If
Next B
If Inicio <> TotalFilas And Final <> 0 Then
Rows(Trim(Str(Inicio)) & ":" & Trim(Str(Final))).Select
Selection.Rows.Group
Inicio = Final + 1
End If
 
If FinDatos=True Then Exit For
 
Next x
Next Col
 
fin:
End Sub

1
2
3
4
5
Function Letra_Columna(ByVal Col As Long) As String
 
Letra_Columna = Replace$(Cells(1, Col).Address(False, False), "1", "")
 
End Function
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar