Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Buscar un dato y volcar parte de esos valores a las celdas

EGR33

Por EGR33
en Macros y programación VBA

Recommended Posts

EGR33 Novato

EGR33

publicado
publicado

estoy parado en una consulta de una tabla y volcar parte de esa información a unas celdas.

Sub BASE_DE_DATOS()

Dim datConnection As ADODB.Connection

Dim recSet As ADODB.Recordset

Dim strDB, strSQL As String

Dim strTabla As String

strDB = "C:\Users\****\Desktop\TRABAJO\INFORME DIARIO RETRASOS LPA.mdb": MsgBox " Usted esta conectado a la base de datos ", vbInformation, " Conectado " 'si en otra carpeta

'nombre de la tabla del archivo Access

strTabla = "RETRASOS"

'crear la conexión

Set datConnection = New ADODB.Connection

Set recSet = New ADODB.Recordset

datConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _

"Data Source =" & strDB & ";"

'consulta SQL

aqui es mi problema

quiero que segun la celda a14 que es la fecha me filtre y busque el valor de la celda m14 y el valor de la celda n14.

Cuando esto se consiga. dentro de la tabla me devuelva clv1 en la celda a20. clv2 en la celda b15 y algun dato mas.

estaría agradecido por toda la ayuda posible.

EGR33 Novato

EGR33

publicado
  • Autor
publicado

strSQL = "SELECT * FROM " & strTabla & " where '" & Range("m14") & "' and '" & Range("b14") & "' and '" & Range("n14") & "'"

recSet.Open strSQL, datConnection

'copiar datos a la hoja

seria algo asi

la cuestion es volcar

dentro de ese registro

ed a la hoja1 en la celda a5

ad a la hoja1 en la celda k7

tengo la tabla

IDORDEN Autonumeración

FECHA Fecha/Hora

CIA Texto

VUELO Texto

AGENTECIC Texto

RETRASO memo

ILIMP Fecha/Hora

FLIMP Fecha/Hora

y mas datos

según tengo de momento, los valores de la hoja1 celda b14(fecha) , celda m14(cia),celda n14(vuelo).

busque esos datos en la tabla y me vuelque. unos valores como agentecic , ilimp,flimp. en la hoja1.

el valor agentecic en la hoja1 celda a26

el valor ilimp en la hoja1 celda c30

estaría agradecido.

EGR33 Novato

EGR33

publicado
  • Autor
publicado

El tema es que los datos los coge de otros datos

Sub BUSCAR_SALIDA()

Application.ScreenUpdating = False

Dim fso As New FileSystemObject

Dim ts As TextStream

Dim strCodigo As String

Dim strLinea As String

Set ts = fso.OpenTextFile("C:\Users\****\Desktop\TRABAJO\CURSO\MAPPERS.PV")

strCodigo = UCase(ActiveSheet.Range("A14")) ' & Format(Range("a11"), "ddYYYYMM"))

Do While Not (ts.AtEndOfStream)

strLinea = ts.ReadLine

If strCodigo = Left(strLinea, Len(strCodigo)) Then

SVALOR1 = Mid(strLinea, 1, 8)

SVALOR2 = Mid(strLinea, 9, 8)

Dim datFecha As Date

Dim sCodigo As String

sCodigo = Mid(strLinea, 9, 8)

datFecha = DateSerial(Mid(sCodigo, 3, 4), Mid(sCodigo, 7, 2), Mid(sCodigo, 1, 2))

SVALOR3 = Mid(strLinea, 19, 2)

SVALOR3a = Mid(strLinea, 21, 2)

SVALOR4 = Mid(strLinea, 193, 2)

SVALOR4a = Mid(strLinea, 195, 2)

SVALOR5 = Mid(strLinea, 95, 2)

SVALOR5A = Mid(strLinea, 101, 2)

SVALOR5b = Mid(strLinea, 107, 2)

SVALOR6 = Mid(strLinea, 23, 3)

SVALOR7 = Mid(strLinea, 31, 5)

SVALOR8 = Mid(strLinea, 97, 2)

SVALOR811 = Mid(strLinea, 97, 1)

SVALOR81 = Mid(strLinea, 99, 2)

SVALOR8a = Mid(strLinea, 103, 2)

SVALOR8aa = Mid(strLinea, 103, 1)

SVALOR8a1 = Mid(strLinea, 105, 2)

SVALOR8b = Mid(strLinea, 109, 2)

SVALOR8bb = Mid(strLinea, 109, 1)

SVALOR8b1 = Mid(strLinea, 111, 2)

SVALOR11 = Mid(strLinea, 136, 10)

SVALOR18 = Mid(strLinea, 724, 38)

SVALOR10 = Mid(strLinea, 985, 2)

SVALOR10aa = Mid(strLinea, 985, 1)

SVALOR10A = Mid(strLinea, 987, 2)

SVALOR13 = Mid(strLinea, 543, 2)

SVALOR13A = Mid(strLinea, 545, 3)

SVALOR13B = Mid(strLinea, 548, 3)

SVALOR13C = Mid(strLinea, 551, 2)

SVALOR12 = Mid(strLinea, 181, 2)

SVALOR12A = Mid(strLinea, 183, 2)

SVALOR14 = Mid(strLinea, 38, 4)

SVALOR15 = Mid(strLinea, 28, 3)

SVALOR16 = Mid(strLinea, 225, 14)

SVALOR19 = Mid(strLinea, 1, 3)

SVALOR19a = Mid(strLinea, 5, 4)

Exit Do

End If

Loop

ActiveSheet.Range("a17").Value = UCase(SVALOR7)

If ActiveSheet.Range("a17") = "" Then

MsgBox ("VUELO NO ENCONTRADO :)"): Exit Sub

Else

ActiveSheet.Range("a14").Value = UCase(SVALOR1) 'vuelo

ActiveSheet.Range("o14") = UCase(datFecha) 'fecha

ActiveSheet.Range("b14").Value = Format(Range("o14"), "dd/mm/yyyy")

ActiveSheet.Range("l14").Value = UCase(SVALOR11) 'vuelo de llegada

ActiveSheet.Range("f14").Value = UCase(SVALOR4 & ":" & SVALOR4a) 'atd

ActiveSheet.Range("e14").Value = UCase(SVALOR3 & ":" & SVALOR3a) 'std

ActiveSheet.Range("a26").Value = UCase(SVALOR18) 'si

ActiveSheet.Range("g14").Value = UCase(SVALOR5) 'dly1

ActiveSheet.Range("h14").Value = UCase(SVALOR5A) 'dly2

ActiveSheet.Range("i14").Value = UCase(SVALOR5b) 'dly3

ActiveSheet.Range("l17").Value = UCase(SVALOR811) 'ojo1

If ActiveSheet.Range("l17") = " " Then

ActiveSheet.Range("l17") = ""

Else

ActiveSheet.Range("g17").Value = UCase(SVALOR8 & ":" & SVALOR81) 'time dly ojo1

End If

ActiveSheet.Range("m17").Value = UCase(SVALOR8aa) ' ojo2

If ActiveSheet.Range("m17") = " " Then

ActiveSheet.Range("m17") = ""

Else

ActiveSheet.Range("h17").Value = UCase(SVALOR8a & ":" & SVALOR8a1) 'time dly ojo2

End If

ActiveSheet.Range("n17").Value = UCase(SVALOR8bb) 'ojo3

If ActiveSheet.Range("n17") = " " Then

ActiveSheet.Range("n17") = ""

Else

ActiveSheet.Range("i17").Value = UCase(SVALOR8b & ":" & SVALOR8b1) 'time dly ojo3

End If

ActiveSheet.Range("c17").Value = UCase(SVALOR6) 'destino

ActiveSheet.Range("l23").Value = UCase(SVALOR10aa) 'ojo4

If ActiveSheet.Range("l23") = " " Then

ActiveSheet.Range("l23") = ""

Else

ActiveSheet.Range("g23").Value = UCase(SVALOR10 & ":" & SVALOR10A) 'ctot ojo4

End If

ActiveSheet.Range("e17").Value = UCase(SVALOR13B & "+" & SVALOR13C) 'pax

ActiveSheet.Range("h23").Value = UCase(SVALOR12 & ":" & SVALOR12A) 'doors

ActiveSheet.Range("d17").Value = UCase(SVALOR14) 'pkn

ActiveSheet.Range("b17").Value = UCase(SVALOR15) 'avo

ActiveSheet.Range("d23").Value = UCase(SVALOR16) 'osi_s

ActiveSheet.Range("m14").Value = UCase(SVALOR19)

ActiveSheet.Range("n14").Value = UCase(SVALOR19a)

End If

BUSCAR_LLEGADA

BASE_DE_DATOS

Application.ScreenUpdating = True

End Sub

Sub BUSCAR_LLEGADA()

Application.ScreenUpdating = False

Dim fso As New FileSystemObject

Dim ts As TextStream

Dim strCodigo As String

Dim strLinea As String

Set ts = fso.OpenTextFile("C:\Users\****\Desktop\TRABAJO\CURSO\MAPPERL.PV")

strCodigo = UCase(ActiveSheet.Range("l14"))

Do While Not (ts.AtEndOfStream)

strLinea = ts.ReadLine

If strCodigo = Left(strLinea, Len(strCodigo)) Then

SVALOR1 = Mid(strLinea, 19, 2)

SVALOR2 = Mid(strLinea, 21, 2)

SVALOR3 = Mid(strLinea, 50, 2)

SVALOR4 = Mid(strLinea, 52, 2)

SVALOR5 = Mid(strLinea, 101, 14)

Exit Do

End If

Loop

ActiveSheet.Range("c14").Value = UCase(SVALOR1 & ":" & SVALOR2) 'sta

ActiveSheet.Range("d14").Value = UCase(SVALOR3 & ":" & SVALOR4) 'ata

ActiveSheet.Range("a23").Value = UCase(SVALOR5) 'SI LLEGADAS

Application.ScreenUpdating = True

End Sub

Sub BASE_DE_DATOS()

'dimensiones

Dim datConnection As ADODB.Connection

Dim recSet As ADODB.Recordset

Dim strDB, strSQL As String

Dim strTabla As String

Dim mifecha As String

mifecha = ActiveSheet.Range("b14").Value

'strDB = "N:\Comparte\Escala\Informes_Retrasos\INFORME DIARIO RETRASOS LPA.mdb"

strDB = "C:\Users\****\Desktop\TRABAJO\INFORME DIARIO RETRASOS LPA.mdb": MsgBox " Usted esta conectado a la base de datos ", vbInformation, " Conectado " 'si en otra carpeta

'nombre de la tabla del archivo Access

strTabla = "RETRASOS"

'crear la conexión

Set datConnection = New ADODB.Connection

Set recSet = New ADODB.Recordset

datConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _

"Data Source =" & strDB & ";"

'consulta Sql

strSQL = "SELECT * FROM strTabla where mifecha between '" & Range("m14") & "' and '" & Range("n14") & "'"

recSet.Open strSQL, datConnection

'copiar datos a la hoja

ActiveSheet.Range("a29").Value = recSet.Fields("RETRASO")

'desconectar

recSet.Close: Set recSet = Nothing

datConnection.Close: Set datConnection = Nothing

End Sub

me da error

no se si hace falta algo mas

daily.xls

INFORME.rar

EGR33 Novato

EGR33

publicado
  • Autor
publicado

como puedes ver tengo tres celdas. la primera es la fecha, la segunda y la tercera son datos. estos datos los capta de un archivo txt y los vuelca.

lo que necesito es que en la tabla RETRASOS busque ese registro que coincida esos datos.

y busque

[TABLE=width: 127]

[TR]

[TD]F.Desembarque[/TD]

[/TR]

[TR]

[/TR]

[TR]

[TD] [/TD]

[/TR]

[/TABLE]

[TABLE=width: 67]

[TR]

[TD]E.Tacito[/TD]

[/TR]

[TR]

[/TR]

[TR]

[TD] [/TD]

[/TR]

[/TABLE]

[TABLE=width: 85]

[TR]

[TD]Listo Crew[/TD]

[/TR]

[TR]

[/TR]

[TR]

[TD] [/TD]

[/TR]

[/TABLE]

[TABLE=width: 80]

[TR]

[TD=class: xl25, width: 80]I.Fuel[/TD]

[/TR]

[TR]

[/TR]

[TR]

[TD=class: xl24, width: 80] [/TD]

[/TR]

[/TABLE]

[TABLE=width: 409]

[TR]

[TD]F.Fuel[/TD]

[TD]I.Pax[/TD]

[TD]F.pax[/TD]

[TD]I.Bodegas[/TD]

[TD]F.Bodegas[/TD]

[/TR]

[TR]

[/TR]

[TR]

[TD] [/TD]

[TD] [/TD]

[TD] [/TD]

[TD] [/TD]

[TD] [/TD]

[/TR]

[/TABLE]

Causa Retraso

dicha información una vez localizada volcar la en las celdas .

Estaría agradecido .

slds

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29
    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Cambios en el Control Horario
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • jues
      Guardar Formulario en PDF

      Por jues · publicado

      Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • DiegoLG
      Surtido de Mercancía

      Por DiegoLG · publicado

      @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • jose_alk
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por jose_alk · publicado

      Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • jues
      Buscar Datos con un ComboBox

      Por jues · publicado

      Exelente solución mil gracias 
    • JSDJSD
      Surtido de Mercancía

      Por JSDJSD · publicado

      Podrías compartir tu solucion

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.