Appeler Excel a partir d’access:

Version imprimable

Bonsoir a tous,
Je pense que j’ai vraiement besoin de votre precieuse aide.
J’utilise ce bout de code pour ouvrir un fichier excel sur l’onglet (Data_Options) a partir d’Access. Ensuite, je remplace les elements suivants (“0”, "[NULL]" et "NULL" ) par “”.
La plage d’excel a parcourir est un peu balaise (Range("A1:GL5206")). En consequence, la procedure met trop de temps pour s’executer.
Je serais tres reconnaissant si vous pouvez me suggerer d’autres facons plus efficacies et surtout rapides d’effectuer la meme operation.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub CleanNulls()
 
      Dim strOptionsExcelFileName As String
      strOptionsExcelFileName = "C:\Documents and Settings\Bonero\Desktop\T2_Canx_CnC_AOT_Weekly\Bonero_Raw_Data.xlsm"
 
    'j'utilise une Early-Binding.
      Dim objXLApp As Excel.Application
      Dim objXLBook As Excel.Workbook
      Dim rngUsedRange As Excel.Range, oRange As Excel.Range
      Dim i As Integer, j As Integer
 
      Set objXLApp = CreateObject("Excel.Application")
      Set objXLBook = objXLApp.Workbooks.Open(strOptionsExcelFileName)
      objXLApp.Application.Visible = True
 
      Set rngUsedRange = objXLBook.Worksheets("Data_Options").usedrange
 
 
      objXLApp.ScreenUpdating = False
 
       For Each oRange In rngUsedRange
 
            Select Case UCase(CStr(Trim(oRange.Value)))
                    Case "0", "[NULL]", "NULL"
                      oRange.Value = ""
          End Select
 
 
     Next oRange
 
    objXLApp.ScreenUpdating = True
 
    objXLBook.Save
    objXLApp.Quit
    Set objXLApp = Nothing
 
End Sub

salut,

au lieu de faire du remplacement cellule par cellule, tu peux utiliser le remplacer tout :)

Exemple :

Code:

1
2
3
4
5
6
7
8
9
10
    Columns("A1:GL5206").Select
    Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Selection.Replace What:="[NULL]", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Selection.Replace What:="NULL", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

bonsoir et merci pour ton code.
il m’a permis de reduire le temps d’execution de ma procedure.
Par contre, certaines colonnes de la meme plage contient des donnees numeriques qui sont stockees comme du textes avec un petit triangle vert au coin superieur gauche de la cellule.
Je me sers du code suivant pour corriger cela mais la encore , c’est extrement lent. Je dois preciser ici qu’un code similaire s’execute en 1 minute en si executee directement en Excel.
Auriez –vous des pistes de reflexions a me suggerer ?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 Sub subCleanData(strExcelFileName As String, strExcelTabName As String) Dim objXLApp As Excel.Application ': i use early binding here. Dim objXLBook As Excel.Workbook Dim rngUsedRange As Excel.Range, oRange As Excel.Range Set objXLApp = CreateObject("Excel.Application") Set objXLBook = objXLApp.Workbooks.Open(strExcelFileName) objXLApp.Application.Visible = True Set rngUsedRange = objXLBook.Worksheets(strExcelTabName).usedrange objXLApp.ScreenUpdating = False objXLApp.DisplayAlerts = False '=> solution au probleme de "Number stored as text" For Each oRange In rngUsedRange oRange.Value = oRange.Value Next oRange objXLApp.DisplayAlerts = True objXLApp.ScreenUpdating = True objXLBook.Save objXLApp.Quit Set objXLApp = Nothing End Sub