Jump to content

Macro para buscar en base de datos por código


Dani2020

Recommended Posts

Hace 8 horas, Dani2020 dijo:

Si me pueden ayudar con macro para buscar en base de datos por código

Te dejo la solución con macros. EL código esta en el evento de la Hoja datos, así que se ejecuta automáticamente al poner el código.

Pero no te hubiese hecho falta macro, con la fórmula siguiente en la columna B obtienes el mismo resultado

=BUSCARV(A2;BD!$A$2:$B$8;2)

Copia de Libro1.xlsm

Link to comment
Share on other sites

Ocupo unir el código

Private Sub Worksheet_Change(ByVal Target As Range)

Dim uFo&, nom%

If Not Intersect(Range("F:F"), Target) Is Nothing Then
    If Target.Text <> "" Then
        With Sheets("Datos")
            uFo = .Range("A" & Rows.Count).End(xlUp).Row
            nom = Target
            Target.Offset(, 1) = WorksheetFunction.VLookup(nom, .Range("$A$1:$B$" & uFo), 2, 0)
        End With
    End If
Else
    Exit Sub
End If

End Sub

Con este otro

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Salida
'--
If Target.Address = "$G$2" Then
   MESES
   Exit Sub
End If
'--
Application.ScreenUpdating = False
Dim celda As Range
If Not Intersect(Target, Range("I7:AM" & Range("FIN").Row)) Is Nothing Then
   Application.EnableEvents = False
   For Each celda In Target
      celda = UCase(celda)
      Select Case celda
         Case "T":    celda.Interior.Color = RGB(0, 204, 204)
         Case "L":    celda.Interior.Color = RGB(119, 210, 85)
         Case "DLJ":  celda.Interior.Color = RGB(255, 204, 204)
         Case "V":    celda.Interior.Color = RGB(255, 255, 204)
         Case "C":    celda.Interior.Color = RGB(255, 229, 204)
         Case "BI":   celda.Interior.Color = RGB(189, 183, 107)
         Case "HA":   celda.Interior.Color = RGB(65, 105, 225)
         Case "RDF":  celda.Interior.Color = RGB(255, 0, 0)
         Case Else:   celda.Interior.ColorIndex = xlNone
      End Select
   Next
End If
'--
Salida:
   Application.EnableEvents = True
End Sub

ROL VERSION 3.xlsm

Link to comment
Share on other sites

Private Sub Worksheet_Change(ByVal Target As Range)

Dim uFo&, nom%

On Error GoTo Salida

If Not Intersect(Range("F:F"), Target) Is Nothing Then
    If Target.Text <> "" Then
        With Sheets("Datos")
            uFo = .Range("A" & Rows.Count).End(xlUp).Row
            nom = Target
            Target.Offset(, 1) = WorksheetFunction.VLookup(nom, .Range("$A$1:$B$" & uFo), 2, 0)
        End With
    End If
    Exit Sub
End If

'--
If Target.Address = "$G$2" Then
   MESES
   Exit Sub
End If
'--
Application.ScreenUpdating = False
Dim celda As Range
If Not Intersect(Target, Range("I7:AM" & Range("FIN").Row)) Is Nothing Then
   Application.EnableEvents = False
   For Each celda In Target
      celda = UCase(celda)
      Select Case celda
         Case "T":    celda.Interior.Color = RGB(0, 204, 204)
         Case "L":    celda.Interior.Color = RGB(119, 210, 85)
         Case "DLJ":  celda.Interior.Color = RGB(255, 204, 204)
         Case "V":    celda.Interior.Color = RGB(255, 255, 204)
         Case "C":    celda.Interior.Color = RGB(255, 229, 204)
         Case "BI":   celda.Interior.Color = RGB(189, 183, 107)
         Case "HA":   celda.Interior.Color = RGB(65, 105, 225)
         Case "RDF":  celda.Interior.Color = RGB(255, 0, 0)
         Case Else:   celda.Interior.ColorIndex = xlNone
      End Select
   Next
End If
'--
Salida:
   Application.EnableEvents = True
End Sub

 

Link to comment
Share on other sites

×
×
  • Create New...

Important Information

Privacy Policy