Excel VBA Skriptunterstützung

Question

Ich schrieb ein VBA-Skript, um Felder in Excel zu vergleichen. Excel friert die Sekunde ein, auf die ich den Knopf klicke. Es werden keine Fehlermeldungen angezeigt. Jedes Mal, wenn ich versuche, es auszuführen, muss ich control alt delete verwenden, um Excel zu schließen. eine meiner Variablen ist auskommentiert, weil, nachdem ich dies zur Arbeit habe ich plane, die Daten auf ein anderes Blatt zu kopieren, anstatt die Schriftart zu ändern. nur ein FYI

Private Sub CommandButton4_Click() 
Dim rng1, rng2, cell1, cell2 As Range 
Set rng1 = Worksheets("Main").Range("B:B") 
Set rng2 = Worksheets("CSV Transfer").Range("D:D") 
'Set rng3 = Worksheets("Data").Range("A:A") 

For Each cell1 In rng1 
For Each cell2 In rng2 

If IsEmpty(cell2.Value) Then Exit For 
If cell1.Value = cell2.Value Then 

cell1.Font.Bold = True 
cell1.Font.ColorIndex = 2 
cell1.Interior.ColorIndex = 3 
cell1.Interior.Pattern = xlSolid 
cell2.Font.Bold = True 
cell2.Font.ColorIndex = 2 
cell2.Interior.ColorIndex = 3 
cell2.Interior.Pattern = xlSolid 

End If 

Next cell2 
Next cell1 


End Sub 

Edit: gesamte Beitrag wird geändert mein eigentliches Problem zu reflektieren.

Answer 1

Ihr Makro friert nicht ein, Sie geben ihm einfach nicht genug Zeit, um fertig zu werden - was eine lange Zeit ist. Excel hat eine Zeilenbegrenzung von 1.048.576 Zeilen und Sie vergleichen jede einzelne Zelle in jeder Zeile mit jeder einzelnen Zelle in der anderen Zeile. Das sind insgesamt 1.099.511.627.776 Zellvergleiche. Angenommen, Sie können 100.000 Vergleiche pro Sekunde durchführen (was wahrscheinlich sogar eine Ausdehnung von ohne Formatierung ist), wird dies schließlich in etwas mehr als 127 Tagen abgeschlossen sein.

Ich würde vorschlagen, ein paar Dinge zu tun. Erstens, wenn Sie einen Bereich an eine Spalte wie folgt zuweisen ...

Set rng1 = Worksheets("Main").Range("B:B") 

... Sie erhalten jede möglich Zelle - nicht nur die Gebrauchten. Hier finden Sie die letzte nicht leere Zelle in jeder Spalte, und stellen Sie Ihre Bereiche basierend auf, dass:

Dim LastRow As Long 
Dim ColumnB As Range 
With Worksheets("Main") 
    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row 
    Set ColumnB = .Range("B1:B" + LastRow) 
End With 

Dies könnte erhalten Sie Ihre Laufzeiten auf die Größenordnung von Minuten oder Sekunden statt Tagen, wenn Sie eine große Datenmenge haben. Um sie weiter zu verbessern, stoppt aus dem Arbeitsblatt einzelnen Werten anfordert einen nach dem anderen, und ziehen Sie sie in Arrays:

Dim BValues As Variant 
BValues = ColumnB.Value 

Dann nur Schleife durch und vergleichen Werte im Speicher. Es aussehen könnte mehr so ​​etwas wie diese (Ich zog die in einen Unter Formatierung out):

Private Sub CommandButton4_Click() 
    Dim LastRow As Long, MainSheet As Worksheet, CsvSheet As Worksheet 

    Set MainSheet = Worksheets("Main") 
    Set CsvSheet = Worksheets("CSV Transfer") 

    Dim MainValues As Variant 
    With MainSheet 
     LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row 
     MainValues = .Range("B1:B" & LastRow).Value 
    End With 

    Dim CsvValues As Variant 
    With CsvSheet 
     LastRow = .Cells(.Rows.Count, "D").End(xlUp).Row 
     CsvValues = .Range("D1:D" & LastRow).Value 
    End With 

    Dim MainRow As Long, CsvRow As Long 
    For MainRow = LBound(MainValues) To UBound(MainValues) 
     For CsvRow = LBound(CsvValues) To UBound(CsvValues) 
      If MainValues(MainRow) = CsvValues(CsvRow) Then 
       FormatCell MainSheet, MainRow, 2 
       FormatCell CsvValues, CsvRow, 4 
      End If 
     Next 
    Next 
End Sub 

Private Sub FormatCell(sheet As Worksheet, formatRow As Long, formatCol As Long) 
    With sheet.Cells(formatRow, formatCol) 
     With .Font 
      .Bold = True 
      .ColorIndex = 2 
     End With 
     With .Interior 
      .ColorIndex = 3 
      .Pattern = xlSolid 
     End With 
    End With 
End Sub 

ich auch ScreenUpdates bei dest ausschalten würde, wenn Ihre Leistung immer noch zu niedrig ist.