hola amigos, tengo un problema, estoy realisando un sistema donde exportando datos a hojas de excel, el problema es que tengo muchos datos (unos 500 mil registros de una sola tabla, y son 4, saquen su pluma
),y claro pues la hojas de excel solo tienen 65536 filas, asi que quiero saber como hago para pasar los datos a otras hojas. gracias
ahhhh, otro problemita es, que este proceso demora demasiado (alrrededor de 30 minutos hasta + ). no se si habra otra manera de hacer este proceso, mi sistema tiene dos opciones, una es guardar y la otra es ver la hoja de excel
el codigo:
Sub excel_CN(ByVal SQL As String, Titulo As String)
Screen.MousePointer = vbHourglass
Dim objExcel As New Excel.Application
Dim Lib As New Excel.Workbook
Dim Hoja As New Excel.Worksheet
Dim sw As Long, xx As Long, n As Long, i As Long
Dim rsTemp As ADODB.Recordset
Set rsTemp = New ADODB.Recordset
rsTemp.Open SQL, oCnn, adOpenStatic, adLockReadOnly
sw = rsTemp.RecordCount 'total de registros
xx = rsTemp.Fields.Count 'total de columnas
'Set objExcel = CreateObject("Excel.Application")
Set Lib = objExcel.Workbooks.Add
Set Hoja = Lib.Worksheets(1)
objExcel.Visible = True
Hoja.Cells(1, 1) = Titulo
'Formato de las celdas de los titulos
With Hoja
.Range("A1").Font.ColorIndex = 1
.Range("A1").Font.Size = 15
.Range(.Cells(1, 1), .Cells(1, xx)).HorizontalAlignment = xlHAlignCenterAcrossSelection
.Range(.Cells(3, 1), .Cells(3, xx)).Borders.LineStyle = xlContinuous
.Range(.Cells(3, 1), .Cells(3, xx)).Font.Bold = True
.Range(.Cells(3, 1), .Cells(3, xx)).Font.Italic = True
.Range(.Cells(3, 1), .Cells(3, xx)).Font.Color = vbWhite
.Range(.Cells(3, 1), .Cells(3, xx)).Interior.ColorIndex = 1
.Range(.Cells(3, 1), .Cells(3, xx)).Interior.Pattern = xlSolid
End With
'llenar celdas titulos
For n = 0 To xx - 1
Hoja.Cells(3, n + 1) = rsTemp.Fields(n).Name
Hoja.Cells(3, n + 1).Font.Size = 10.5
Next
'llenar celdas
For i = 0 To sw - 1
For n = 0 To xx - 1
Hoja.Cells(i + 4, n + 1) = Trim(rsTemp.Fields(n))
If rsTemp.Fields(n).Name = "ano_prese" Or rsTemp.Fields(n).Name = "ANO_PRESE" Or rsTemp.Fields(n).Name = "mes" Or rsTemp.Fields(n).Name = "MES" Then
Hoja.Cells(i + 4, n + 1).NumberFormat = "00"
End If
If rsTemp.Fields(n).Name = "nume_corre" Or rsTemp.Fields(n).Name = "NDCL" Or rsTemp.Fields(n).Name = "NDCLREG" Then
Hoja.Cells(i + 4, n + 1).NumberFormat = "000000"
End If
If rsTemp.Fields(n).Name = "sector" Or rsTemp.Fields(n).Name = "SECTOR" Or rsTemp.Fields(n).Name = "CADU" Then
Hoja.Cells(i + 4, n + 1).NumberFormat = "000"
End If
If rsTemp.Fields(n).Name = "CAGE" Then
Hoja.Cells(i + 4, n + 1).NumberFormat = "0000"
End If
Next
With Hoja
.Range(.Cells(i + 4, 1), .Cells(i + 4, xx)).Borders.LineStyle = xlContinuous
End With
rsTemp.MoveNext
Next
Hoja.Columns.AutoFit
If SaveExcel = True Then
objExcel.ActiveWorkbook.SaveAs FileName:=Formulario.CDialog.FileName, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
SaveExcel = False
Lib.Saved = True
Lib.Close
objExcel.Quit
MsgBox "Hoja de calculo guardada en: " & vbCrLf _
& Formulario.CDialog.FileName, vbInformation, "SISTEMA"
Else
' objExcel.Visible = True
End If
rsTemp.Close
Set rsTemp = Nothing
Set objExcel = Nothing
Screen.MousePointer = vbDefault
End Sub
estos procesos demoran demasiado, si alguien sabe alguna manera de hacer estos procesos mas rapidos por favor respondan , gracias de antemano
bye
