Ordenar datos de un QueryTable

15/07/2009 - 18:57 por Erik Copado | Informe spam
Hola gente:

Estoy entrampado en la siguiente situación y pido su ayuda para poder
salir.

Estoy generando un recodset de la base de datos ordenado por los
campos marca, linea y a partir de este genero un recordset
desconectado el cual lo estoy ordenando por los campos Categoria (Por
este campo fue que tuve que hacerlo desconectado, por que no biene en
la base de datos si no que lo calculo en base al campo marca), Marca,
Linea. utilizo la propiedad sort y lo hace sin mayor problema.

El caso es que el recordset desconectado lo estoy asignando a un
QueryTable para reportar la información.El problema es que cuando el
QueryTable se ejecuta lo escribe ordenado como marca, linea(que asi
esta ordenado el recordset que biene de la base de datos) y no como
Categoria, Marca, Linea que fue asi como lo ordene.

Pero ahorita que les estoy describiendo mi problema se me acaba de
ocurrir que voy a utilizar el metodo "CopyFromRecordset"

De todas formas les dejo mi codigo para ver si me pudieran decir que
estoy haciendo mal.

Muchas gracias por la atencion a este mensaje.

Atte.
Erik Copado

Private Function rsReporte() As ADODB.Recordset
'Arma la estructura de Recordset Desconectado
Dim rs As ADODB.Recordset
Dim MesIni As Integer
Dim MesFin As Integer
Dim i As Integer

MesIni = Mes
MesFin = MesIni + Meses
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic

rs.Fields.Append "Categoria", adVarChar, 50
rs.Fields.Append "Marca", adVarChar, 50
rs.Fields.Append "Linea", adVarChar, 50
rs.Fields.Append "Ref.Nacional", adVarChar, 16
rs.Fields.Append "Ref.P&G", adVarChar, 16
rs.Fields.Append "Descripcion", adVarChar, 40
For i = MesIni To MesFin
rs.Fields.Append "NetSale" & i, adDouble, 10
rs.Fields.Append "InvFin" & i, adDouble, 10
rs.Fields.Append "Cober" & i, adDouble, 10
rs.Fields.Append "Compra" & i, adDouble, 10
Next i
rs.Open , Nothing
Set rsReporte = rs
End Function

Private Function Llena_rsRep(ByRef rsDatos As ADODB.Recordset) As
ADODB.Recordset
'llena el Recordset Desconectado con el Recordset Conectado
Dim rsRep As ADODB.Recordset
Dim i As Integer
Dim MesIni As Integer
Dim MesFin As Integer

MesIni = Mes
MesFin = MesIni + Meses

Set rsRep = rsReporte
rsDatos.MoveFirst
While Not rsDatos.EOF
rsRep.AddNew
rsRep!Categoria = Categoria(rsDatos.ActiveConnection, rsDatos!
ID) 'funcion que genera la categoria en base a la marca
rsRep!Marca = Format(rsDatos!Linea, "00") & " - " & Trim
(rsDatos!NOMLIN)
rsRep!Linea = Format(rsDatos!Grupo, "0000") & " - " & Trim
(rsDatos!NOMGPO)
rsRep![Ref.Nacional] = Trim(rsDatos!Num_Producto)
rsRep![Ref.P&G] = Trim(rsDatos!Num_Prod_Prov)
rsRep!Descripcion = Trim(rsDatos!DESCRIP_ING)
For i = MesIni To MesFin
rsRep.Fields("NetSale" & i).Value = rsDatos.Fields("Vta" &
i).Value
rsRep.Fields("InvFin" & i).Value = rsDatos.Fields("InvFin"
& i).Value
rsRep.Fields("Cober" & i).Value = rsDatos.Fields("Cober" &
i).Value / 100
rsRep.Fields("Compra" & i).Value = rsDatos.Fields("Compra"
& i).Value
Next i
DoEvents
rsDatos.MoveNext
Wend
Set Llena_rsRep = rsRep
End Function

Private Sub InfoCobertura(ByRef cn As ADODB.Connection)
Dim Query As String
Dim strcn As String
Dim MesIni As Integer
Dim MesFin As Integer
Dim i As Integer
Dim J As Integer
Dim rs As ADODB.Recordset
Dim rsRep As ADODB.Recordset


' Mes = 7
' Meses = 5
MesIni = Mes
MesFin = MesIni + Meses

Set rs = New ADODB.Recordset

Query = "SELECT "
Query = Query & "PRODUCTOS_C.LINEA, "
Query = Query & "PRODUCTOS_C.GRUPO, "
Query = Query & "PRODUCTOS_C.NUM_PRODUCTO, "
Query = Query & "PRODUCTOS_C.NUM_PROD_PROV, "
Query = Query & "PRODUCTOS_C.DESCRIP_ING, "
Query = Query & "LINEAS.DESCRIP AS NOMLIN, "
Query = Query & "GRUPOS_C.DESCRIP_ING AS NOMGPO, "
Query = Query & "GRUPOS_C.FRECUENCIA_COM AS ID, "
For i = MesIni To MesFin
Query = Query & "(VTA_UNI_COM_" & i & " + "
Query = Query & "VTA_IMP_FIN_" & i & " + "
Query = Query & "VTA_UNI_FIN_" & i & ") AS Vta" & i & ", "
Query = Query & "INV_UNI_FIN_" & i & " AS InvFin" & i & ", "
Query = Query & "COM_UNI_REAL_" & i & " AS Cober" & i & ", "
If i <> MesFin Then
Query = Query & "COM_UNI_COM_" & i & " AS Compra" & i & ",
"
Else
Query = Query & "COM_UNI_COM_" & i & " AS Compra" & i & "
"
End If
Next i
Query = Query & "FROM PRONOS_COM, PRODUCTOS_C, GRUPOS_C, LINEAS "
Query = Query & "WHERE ((PRODUCTOS_C.NUM_PRODUCTO PRONOS_COM.NUM_PRODUCTO) "
Query = Query & "AND (PRODUCTOS_C.LINEA_GRUPO GRUPOS_C.LINEA_GRUPO) "
Query = Query & "AND (PRODUCTOS_C.LINEA = LINEAS.LINEA)) "
Query = Query & "AND (PRODUCTOS_C.TIPO_ALMACEN = 'PT') "
J = UBound(Lineas)
If J >= 0 And Lineas(0) <> 0 Then
For i = 0 To J
If i = 0 Then
Query = Query & "AND (PRODUCTOS_C.LINEA = " & Lineas
(i) & " "
Else
Query = Query & "OR PRODUCTOS_C.LINEA = " & Lineas(i)
& " "
End If
Next i
Query = Query & ") ORDER BY PRODUCTOS_C.LINEA, "
Query = Query & "PRODUCTOS_C.GRUPO, PRODUCTOS_C.NUM_PRODUCTO "
Else
Query = Query & "ORDER BY PRODUCTOS_C.LINEA, "
Query = Query & "PRODUCTOS_C.GRUPO, PRODUCTOS_C.NUM_PRODUCTO "
End If

'rs es el recordset conectado a la base de datos
rs.CursorLocation = adUseClient
rs.Open Query, cn, adOpenStatic, adLockReadOnly

Set rsRep = Llena_rsRep(rs) 'Funcion que me devuelve el recordset
desconectado lleno

rsRep.MoveFirst
rsRep.Sort = "Categoria, Marca, Linea, [Ref.Nacional]" ordeno mi
recordset desconectado
'con este While valido que si este ordenado
' While Not rsRep.EOF
' Debug.Print rsRep.AbsolutePosition & " - " & rsRep!Categoria
& " - " & rsRep!Marca & " - " & rsRep!Linea
' rsRep.MoveNext
' Wend

'aqui asigno mi recordset desconectado al QueryTable
With ActiveSheet.QueryTables.Add(Connection:=rsRep,
Destination:=ActiveCell)
.Name = "dat_Repor_Cober_Mens"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.PreserveColumnInfo = True
' Set .Recordset = rsRep
' .Recordset.MoveFirst
' .Recordset.Sort = "Categoria DESC"
.Refresh BackgroundQuery:=False
End With
End Sub
 

Leer las respuestas

#1 Erik Copado Perez
15/07/2009 - 19:07 | Informe spam
Hola,

Solo para comentarles que si funciono mucho mejor el CopyFromRecordset.
(ActiveCell.CopyFromRecordset rsRep)

Ya la libre.


"Erik Copado" escribió en el mensaje de
noticias:
Hola gente:

Estoy entrampado en la siguiente situación y pido su ayuda para poder
salir.

Estoy generando un recodset de la base de datos ordenado por los
campos marca, linea y a partir de este genero un recordset
desconectado el cual lo estoy ordenando por los campos Categoria (Por
este campo fue que tuve que hacerlo desconectado, por que no biene en
la base de datos si no que lo calculo en base al campo marca), Marca,
Linea. utilizo la propiedad sort y lo hace sin mayor problema.

El caso es que el recordset desconectado lo estoy asignando a un
QueryTable para reportar la información.El problema es que cuando el
QueryTable se ejecuta lo escribe ordenado como marca, linea(que asi
esta ordenado el recordset que biene de la base de datos) y no como
Categoria, Marca, Linea que fue asi como lo ordene.

Pero ahorita que les estoy describiendo mi problema se me acaba de
ocurrir que voy a utilizar el metodo "CopyFromRecordset"

De todas formas les dejo mi codigo para ver si me pudieran decir que
estoy haciendo mal.

Muchas gracias por la atencion a este mensaje.

Atte.
Erik Copado

Private Function rsReporte() As ADODB.Recordset
'Arma la estructura de Recordset Desconectado
Dim rs As ADODB.Recordset
Dim MesIni As Integer
Dim MesFin As Integer
Dim i As Integer

MesIni = Mes
MesFin = MesIni + Meses
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic

rs.Fields.Append "Categoria", adVarChar, 50
rs.Fields.Append "Marca", adVarChar, 50
rs.Fields.Append "Linea", adVarChar, 50
rs.Fields.Append "Ref.Nacional", adVarChar, 16
rs.Fields.Append "Ref.P&G", adVarChar, 16
rs.Fields.Append "Descripcion", adVarChar, 40
For i = MesIni To MesFin
rs.Fields.Append "NetSale" & i, adDouble, 10
rs.Fields.Append "InvFin" & i, adDouble, 10
rs.Fields.Append "Cober" & i, adDouble, 10
rs.Fields.Append "Compra" & i, adDouble, 10
Next i
rs.Open , Nothing
Set rsReporte = rs
End Function

Private Function Llena_rsRep(ByRef rsDatos As ADODB.Recordset) As
ADODB.Recordset
'llena el Recordset Desconectado con el Recordset Conectado
Dim rsRep As ADODB.Recordset
Dim i As Integer
Dim MesIni As Integer
Dim MesFin As Integer

MesIni = Mes
MesFin = MesIni + Meses

Set rsRep = rsReporte
rsDatos.MoveFirst
While Not rsDatos.EOF
rsRep.AddNew
rsRep!Categoria = Categoria(rsDatos.ActiveConnection, rsDatos!
ID) 'funcion que genera la categoria en base a la marca
rsRep!Marca = Format(rsDatos!Linea, "00") & " - " & Trim
(rsDatos!NOMLIN)
rsRep!Linea = Format(rsDatos!Grupo, "0000") & " - " & Trim
(rsDatos!NOMGPO)
rsRep![Ref.Nacional] = Trim(rsDatos!Num_Producto)
rsRep![Ref.P&G] = Trim(rsDatos!Num_Prod_Prov)
rsRep!Descripcion = Trim(rsDatos!DESCRIP_ING)
For i = MesIni To MesFin
rsRep.Fields("NetSale" & i).Value = rsDatos.Fields("Vta" &
i).Value
rsRep.Fields("InvFin" & i).Value = rsDatos.Fields("InvFin"
& i).Value
rsRep.Fields("Cober" & i).Value = rsDatos.Fields("Cober" &
i).Value / 100
rsRep.Fields("Compra" & i).Value = rsDatos.Fields("Compra"
& i).Value
Next i
DoEvents
rsDatos.MoveNext
Wend
Set Llena_rsRep = rsRep
End Function

Private Sub InfoCobertura(ByRef cn As ADODB.Connection)
Dim Query As String
Dim strcn As String
Dim MesIni As Integer
Dim MesFin As Integer
Dim i As Integer
Dim J As Integer
Dim rs As ADODB.Recordset
Dim rsRep As ADODB.Recordset


' Mes = 7
' Meses = 5
MesIni = Mes
MesFin = MesIni + Meses

Set rs = New ADODB.Recordset

Query = "SELECT "
Query = Query & "PRODUCTOS_C.LINEA, "
Query = Query & "PRODUCTOS_C.GRUPO, "
Query = Query & "PRODUCTOS_C.NUM_PRODUCTO, "
Query = Query & "PRODUCTOS_C.NUM_PROD_PROV, "
Query = Query & "PRODUCTOS_C.DESCRIP_ING, "
Query = Query & "LINEAS.DESCRIP AS NOMLIN, "
Query = Query & "GRUPOS_C.DESCRIP_ING AS NOMGPO, "
Query = Query & "GRUPOS_C.FRECUENCIA_COM AS ID, "
For i = MesIni To MesFin
Query = Query & "(VTA_UNI_COM_" & i & " + "
Query = Query & "VTA_IMP_FIN_" & i & " + "
Query = Query & "VTA_UNI_FIN_" & i & ") AS Vta" & i & ", "
Query = Query & "INV_UNI_FIN_" & i & " AS InvFin" & i & ", "
Query = Query & "COM_UNI_REAL_" & i & " AS Cober" & i & ", "
If i <> MesFin Then
Query = Query & "COM_UNI_COM_" & i & " AS Compra" & i & ",
"
Else
Query = Query & "COM_UNI_COM_" & i & " AS Compra" & i & "
"
End If
Next i
Query = Query & "FROM PRONOS_COM, PRODUCTOS_C, GRUPOS_C, LINEAS "
Query = Query & "WHERE ((PRODUCTOS_C.NUM_PRODUCTO > PRONOS_COM.NUM_PRODUCTO) "
Query = Query & "AND (PRODUCTOS_C.LINEA_GRUPO > GRUPOS_C.LINEA_GRUPO) "
Query = Query & "AND (PRODUCTOS_C.LINEA = LINEAS.LINEA)) "
Query = Query & "AND (PRODUCTOS_C.TIPO_ALMACEN = 'PT') "
J = UBound(Lineas)
If J >= 0 And Lineas(0) <> 0 Then
For i = 0 To J
If i = 0 Then
Query = Query & "AND (PRODUCTOS_C.LINEA = " & Lineas
(i) & " "
Else
Query = Query & "OR PRODUCTOS_C.LINEA = " & Lineas(i)
& " "
End If
Next i
Query = Query & ") ORDER BY PRODUCTOS_C.LINEA, "
Query = Query & "PRODUCTOS_C.GRUPO, PRODUCTOS_C.NUM_PRODUCTO "
Else
Query = Query & "ORDER BY PRODUCTOS_C.LINEA, "
Query = Query & "PRODUCTOS_C.GRUPO, PRODUCTOS_C.NUM_PRODUCTO "
End If

'rs es el recordset conectado a la base de datos
rs.CursorLocation = adUseClient
rs.Open Query, cn, adOpenStatic, adLockReadOnly

Set rsRep = Llena_rsRep(rs) 'Funcion que me devuelve el recordset
desconectado lleno

rsRep.MoveFirst
rsRep.Sort = "Categoria, Marca, Linea, [Ref.Nacional]" ordeno mi
recordset desconectado
'con este While valido que si este ordenado
' While Not rsRep.EOF
' Debug.Print rsRep.AbsolutePosition & " - " & rsRep!Categoria
& " - " & rsRep!Marca & " - " & rsRep!Linea
' rsRep.MoveNext
' Wend

'aqui asigno mi recordset desconectado al QueryTable
With ActiveSheet.QueryTables.Add(Connection:=rsRep,
Destination:=ActiveCell)
.Name = "dat_Repor_Cober_Mens"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.PreserveColumnInfo = True
' Set .Recordset = rsRep
' .Recordset.MoveFirst
' .Recordset.Sort = "Categoria DESC"
.Refresh BackgroundQuery:=False
End With
End Sub

Preguntas similares