Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » como unir dos códigos en uno solo

Excel - como unir dos códigos en uno solo

Volver
Nuevo Tema
<<>>
 
Vista:
Imágen de perfil de celia
Val: 761
Bronce
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

como unir dos códigos en uno solo

Publicado por celia (437 intervenciones) el 16/04/2019 10:14:02
Hola de nuevo.
Quería unir 2 códigos que me habéis resuelto aquí y no lo consigo, me parece muy complicado esto.

---------------------------El código 1 es este que hizo Antoni:

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Fila_Destin As Long, f As Long, Texto As String, _
    Colu_Destin As Long, c As Long
 
    Dim Lin As Integer, Col As Integer
 
    Col = Target.Column
    Fil = Target.Row
 
    If Col >= 65 And Col <= 77 And Fil >= 3 And Fil <= 15 Then Cells(6, 13) = Target.Value
    If Col >= 65 And Col <= 77 And Fil >= 3 And Fil <= 15 Then Cells(12, 13) = Target.Value
    If Col >= 18 And Col <= 30 And Fil >= 3 And Fil <= 15 Then Cells(6, 13) = Target.Value
    If Col >= 18 And Col <= 30 And Fil >= 3 And Fil <= 15 Then Cells(12, 13) = Target.Value
 
    ' ---&---

 
    Application.EnableEvents = False
    If Col = 13 And Fil = 7 Then
        Texto = Cells(7, "M")
        Fila_Destin = 42
        Colu_Destin = 4
 
        For Fil = 42 To 580 Step 15
            For Col = 37 To 134 Step 14
                If Texto = Cells(Fil, Col) Then
                    Range(Cells(Fil,Col), Cells((Fil+12),(Col+12))).Select
                    Selection.Copy
                    Range("D42").Select
                    ActiveSheet.Paste
                    Application.CutCopyMode = False
                    Application.EnableEvents = True
                    Exit Sub
                End If
            Next
        Next
    End If
    Application.CutCopyMode = False
    Application.EnableEvents = True
End Sub


---------------------------El código 2 es este que hizo Norberto:

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.Speech.SpeakCellOnEnter = Target.Address = "$S$23"
    Dim Lin As Integer, Col As Integer, Salir As Boolean
    Dim Fila_Destin As Long, f As Long, Texto As String, _
      Colu_Destin As Long, c As Long
      Col = Target.Column: Application.EnableEvents = False
    Fil = Target.Row
    If Col >= 18 And Col <= 30 And Fil >= 3 And Fil <= 15 Then Cells(19, 19) = Target.Value
    If Col = 13 And Fil = 10 Then
        Fila_Destin = 2
        Colu_Destin = 32: Texto = Cells(10, "M"): Salir = False
         For Fil = 42 To 42 Step 15
            For Col = 37 To 1086 Step 14
                If Texto = Cells(Fil, Col) Then
                    For f = 0 To 0
                        For c = 0 To 13
                            Cells(f + Fila_Destin, c + Colu_Destin) = Cells(f + Fil, c + Col)
                        Next
                    Next
                    Salir = True: Exit For
                End If
            Next
            If Salir = True Then Exit For
        Next
    End If
    Application.EnableEvents = True
    Dim F1 As Long, C1 As Long, F2 As Long, C2 As Long
    On Error GoTo Worksheet_SelectionChange_Err
    If Target.Cells.Count = 1 Then 'Solo está seleccionada una celda

        F1 = CeldaAnterior.Row
        C1 = CeldaAnterior.Column
        F2 = Target.Row
        C2 = Target.Column
        If Abs(C1 - C2) + Abs(F1 - F2) > 1 Then 'Si nos movemos más de una celda

            Set CeldaAnterior = Target
        ElseIf C1 - C2 = 1 Then 'Si nos hemos desplazado una columna a la izquierda

              CeldaAnterior.Activate 'Volvemos a la celda

            Range("s18") = Range("s18") - 0.5   'restamos 0,5 a la celda s18

        ElseIf C2 - C1 = 1 Then 'Si nos hemos desplazado una columna a la derecha

            CeldaAnterior.Activate
            Range("s18") = Range("s18") + 0.5   'sumamos 0,5 a la celda s18

   ElseIf F1 - F2 = 1 Then 'Si nos hemos desplazado una fila arriba

            CeldaAnterior.Activate
            Range("S18") = Range("S18") + 0.5  '

        ElseIf F2 - F1 = 1 Then 'Si nos hemos desplazado una fila abajo

            CeldaAnterior.Activate
            Range("S18") = Range("S18") - 0.5   'restamos

        Else                     'Este caso no creo que se dé.

            Set CeldaAnterior = Target
        End If
    End If
Worksheet_SelectionChange_Err:
End Sub
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