Bonjour a tous,
J’espère que le longueur de ce post ne va pas faire fuir les potentiels lecteurs...
Je commence a m’intéresser au VB.NET et pour débuter mon apprentissage, je tente simplement de convertir des Macros Excel VBA vers VB.NET.
Un Module VBA me permet de comparer 2 Excel Sheets (d'un même fichier). La comparaison ce fait sur les valeurs de la colonne A.
Toute valeur différente entraine un fond de cellule Rouge dans la 1er Sheet. Cette macro fonctionne très bien et est relativement rapide.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67 Sub MdlCompare() Application.ScreenUpdating = False Dim sheetOne As Worksheet, sheetTwo As Worksheet Dim i As Integer Set sheetOne = Worksheets("Export (Excel -> Microstation)") Set sheetTwo = Worksheets("Import (Microstation -> Excel)") 'Reset Color on sheetOne sheetOne.Select LastRowColA = Range("A65536").End(xlUp).Row Range("C3", "IV" & LastRowColA).Select With Selection.Interior .Pattern = xlNone End With Range("A1").Select 'Add column B on sheetTwo sheetTwo.[B:B].Insert 'Set Filter on sheetTwo sheetTwo.Select Rows("2:2").Select Selection.AutoFilter sheetOne.Select 'Look for match between SheetOne and SheetTwo in Column A From Cell A3 For i = 3 To sheetOne.Range("a" & Rows.Count).End(xlUp).Row If Application.CountIf(sheetTwo.Range("a:a"), Cells(i, "a")) <> 0 Then Cells(i, "a").Select 'If Match, highlight the cell A in Yellow and Filter in sheetTwo ' Selection.Interior.ColorIndex = 6 sheetTwo.Select Range("$A$2:$IV$2000").AutoFilter Field:=1, Criteria1:=sheetOne.Cells(i, "a").Value With sheetTwo.Range("a:a") x = [A:A].Find(What:=(sheetOne.Cells(i, "a").Value), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns).Row End With 'If Value is Different between sheetOne and sheetTwo, highlight the cell(s) in Red For j = 3 To 256 ' If sheetOne.Cells(i, j).Value <> "" And sheetOne.Cells(i, j).Value <> sheetTwo.Cells(x, j).Value Then If sheetOne.Cells(i, j).Value <> sheetTwo.Cells(x, j).Value Then sheetOne.Cells(i, j).Interior.ColorIndex = 3 End If Next j sheetOne.Select End If Next i 'Reset Filter on SheetTwo sheetTwo.Select Rows("2:2").Select Selection.AutoFilter 'Delete column B on sheetTwo sheetTwo.Select sheetTwo.[B:B].Delete sheetOne.Select Application.ScreenUpdating = True End Sub
J'ai développé le code VB.NET ci-dessous - qui réalise la même chose - mais le temps d’exécution et bcp long ! Je pense que le fait d'avoir une appli externe a Excel augmente le temps de réponse mais je le trouve tout de même relativement long.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78 '''''''''''''''''''''''''''''''''' ' Compare 2 Excel Worksheets '''''''''''''''''''''''''''''''''' Imports Excel = Microsoft.Office.Interop.Excel Module Module1 Sub MdlCompare() Dim xlsApp As Excel.Application Dim xlsWB As Excel.Workbook Dim xlsSheet As Excel.Worksheet Dim xlsSheetOne As Excel.Worksheet Dim xlsSheetTwo As Excel.Worksheet Dim xlsCell As Excel.Range Dim xlsRange As Excel.Range xlsApp = New Excel.Application xlsApp.Visible = True xlsWB = xlsApp.Workbooks.Open(Form1.LblFile1.Text) '' set up the xlsSheetOne and xlsSheetTwo xlsSheetOne = xlsWB.Worksheets("Export (Excel -> Microstation)") xlsSheetTwo = xlsWB.Worksheets("Import (Microstation -> Excel)") xlsCell = xlsSheetOne.Range("A1") xlsSheetOne.Select() xlsRange = xlsSheetOne.Range("A65536").End(Excel.XlDirection.xlUp).Rows xlsRange = xlsSheetOne.Range("C3", "IV" & xlsRange.Row) xlsRange.Interior.ColorIndex = Nothing 'Add column B on sheet Import xlsSheetTwo.Columns("B").insert() xlsSheetTwo.Rows("2:2").autofilter() xlsSheetOne.Select() 'Look for match between Sheet1 and Sheet2 in Column A From Cell A3 xlsRange = xlsSheetOne.Range("A65536").End(Excel.XlDirection.xlUp).Rows Dim i As Integer Dim x As Integer For i = 3 To xlsRange.Row If xlsApp.WorksheetFunction.CountIf(xlsSheetTwo.Range("a:a"), xlsSheetTwo.Cells(i, "a")) <> 0 Then 'If Match, highlight the cell A in Yellow and Filter in Sheet2 xlsCell(i, "a").Interior.ColorIndex = 6 xlsSheetTwo.Select() xlsSheetTwo.Range("$A$2:$IV$2000").AutoFilter(Field:=1, Criteria1:=xlsSheetOne.Cells(i, "a").Value) With xlsSheetTwo.Range("A:A") x = 3 x = xlsSheetTwo.Range("A:A").Find(What:=(xlsSheetOne.Cells(i, "a").Value), LookIn:=Excel.XlFindLookIn.xlFormulas, LookAt:=Excel.XlLookAt.xlWhole).Row End With 'If Value is Different between sheet1 and sheet2, highlight the cell(s) in Red For j = 3 To 256 If xlsSheetOne.Cells(i, j).Value <> xlsSheetTwo.Cells(x, j).Value Then xlsSheetOne.Cells(i, j).Interior.ColorIndex = 3 End If Next j xlsSheetOne.Select() End If Next i 'Reset Filter on Sheet2 xlsSheetTwo.Rows("2:2").AutoFilter() 'Delete column B on sheet Import xlsSheetTwo.Range("B:B").Delete() xlsSheetOne.Select() xlsApp.Visible = False xlsApp.UserControl = True 'Release object references. xlsCell = Nothing xlsSheet = Nothing xlsWB = Nothing xlsApp.Quit() xlsApp = Nothing End Sub End Module
- Quelqu'un pourrait-il me dire s'il est normal que le temps d’exécution soit bcp plus important ?
- Y-a t'il un moyen pour diminuer ce temps ?
Je crois qu'il est possible de passer par des Tables ou Datagrid pour travailler avec Excel, est-ce une piste a explorer? Si oui auriez-vous un exemple sous la main..?
PS: Si le temps reste toujours trop 'important' a mon gout, je pense dans ce cas créer un nouveau fichier pour lister seulement les différences (type de fichier xls, csv, txt, xml...ou autre). Pourriez-vous me guider dans cette direction ?
Merci
Hervé
Partager