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

[EGR33]

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.

[Antoni]

sql = "Select * from mitabla where mifecha between '" & range("m14") & "' and '" & range("n14") & "'

[EGR33]

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.

[Antoni]

Sin el archivo Excel y la base de datos no va a ser posible continuar.

[EGR33]

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

[Antoni]

Por última vez, sube los archivos:

Sin el archivo Excel xls y la base de datos mdb no va a ser posible continuar.

[EGR33]

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