UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo


No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

Aretradeser


Buenas tardes,
Solicito ayuda para unir estos dos códigos en uno solo.
Muchísimas gracias de antemano.

Código:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
If Target.Count > 1 Then GoTo exitHandler
  Select Case Target.Column
  Case 3, 4, 5
       On Error Resume Next
        Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler
    If rngDV Is Nothing Then GoTo exitHandler
        If Intersect(Target, rngDV) Is Nothing Then
    Else
        Application.EnableEvents = False
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value
        Target.Value = newVal
        If oldVal <> "" Then
          If newVal <> "" Then
            Target.Value = oldVal _
              & ", " & newVal
          End If
        End If
    End If
End Select
exitHandler:
  Application.EnableEvents = True
End Sub





Código:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim rngFechas As Range
      Set rngFechas = Range("I:J") 'Muestra el calendario en cualquier celda de la columna A
        If Union(Target, rngFechas).Address = rngFechas.Address Then _
        Call abrir_calendario
    If Not Intersect(Target, Columns("F")) Is Nothing Then
        Set h = Sheets("Auxiliar")
        For Each c In Target
            If c.Value <> "" Then
                u = h.UsedRange.Rows(h.UsedRange.Rows.Count).Row
                Set b = h.Range("B2:E" & u).Find(c.Value, lookat:=xlWhole)
                If Not b Is Nothing Then
                    Cells(c.Row, "B") = h.Cells(1, b.Column)
                End If
            Else
                Cells(c.Row, "B") = ""
            End If
        Next
    End If
    If Not Intersect(Target, Columns("F")) Is Nothing Then
        Set h = Sheets("Auxiliar")
        For Each c In Target
            If c.Value <> "" Then
                u = h.UsedRange.Rows(h.UsedRange.Rows.Count).Row
                Set b = h.Range("X2:Z" & u).Find(c.Value, lookat:=xlWhole)
                If Not b Is Nothing Then
                    Cells(c.Row, "K") = h.Cells(1, b.Column)
                End If
            Else
                Cells(c.Row, "K") = ""
            End If
        Next
    End If
    If Target.Column = 2 And Target.Row > 1 Then
        If Target.Row = 2 Then
            Sheets("Datos").Cells(Target.Row, 1).Value = 1
            
        Else
            Sheets("Datos").Cells(Target.Row, 1).Value = Sheets("Datos").Cells(Target.Row - 1, 1).Value + 1
            
        End If
    End If
End Sub

jhon1904

avatar
Hola
Lea las normas del foro debes subir un archivo de ejemplo, y asi miramos como te ayudamos

saludos,


_________________
Jhon Mayorquin
https://www.facebook.com/groups/1908894496046888/

jhon1904

avatar
se cierra por abandono...


_________________
Jhon Mayorquin
https://www.facebook.com/groups/1908894496046888/

Contenido patrocinado


Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.