Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen

Makro langsam nach erster Ausführung | Herbers Excel-Forum


Betrifft: Makro langsam nach erster Ausführung von: M.
Geschrieben am: 24.02.2010 13:20:02

Hallo,

ich habe ein Makro geschrieben (mein erstes), welches in einem Sheet daten anhand eines anderen Sheets in der gleichen Excel Datei updated.

Alles funktioniert wunderbar soweit.

Mein Problem: Das Makro läuft blitzschnell durch. Wenn ich es ein zweites mal durchlaufen lasse ist es sehr langsam und es bleibt so langsam, bis ich die speichere. Danach ist es wieder normal schnell.

Ich denke mir also, dass irgendwo ein Cache gelöscht werden muss. Das ist aber nur eine Idee, und ich weiß auch nicht wie ich dieses bewerkstelligen könnte.

Vielleicht weiß jemand rat?

Button ruft hauptmakro auf:

Private Sub CommandButton1_Click() 'Update detailed sheet with country values

Dim v_SheetName As Variant
Dim v_color_index As Variant
Dim v_checkSheet As Variant
Dim ws As Worksheet
Dim x As Integer

v_SheetName = UCase(ActiveCell.Value)
v_color_index = ActiveCell.Interior.ColorIndex

  If MsgBox("Do you want to run the Update for Country: " & UCase(v_SheetName) & "?", _
              vbYesNo + vbQuestion + vbDefaultButton1, "Question") = vbNo Then
        Cancel = True
        ElseIf SheetExists(v_SheetName) Then
        Update_Country_Status v_SheetName, v_color_index 'CALL Update Procedure with current  _
sheet name
        Else
        MsgBox ("Country Sheet does not exist. Add Country to Excel File")
    End If

End Sub
Hauptmakro welches das Update durchführt.
Option Explicit 'All variables needs to be declared
Sub Update_Country_Status(v_SheetName As Variant, v_color_index As Variant)
'
' Macro to update Sheet "DETAILED ALL FUNDS" with the latest information from the Countries  _
sheets
' Version updates and changes:
' 19-FEB-2010:
' TRIM Added to concatenate the fund,subfund,category and class in DETAILED ALL FUNDS sheet ( _
ignores blanks at the beginning and end)
' Copy Sheets to a new excel file including non-default color and date handling via Button in   _
_
Country Sheet

    Dim rCell As Range
    Dim lReply As Long
    Dim v_searchValue As String
    Dim v_CategoryClass As String
    Dim v_UpdateValue As String
    Dim v_CellColorCountrySheet As Long
    Dim v_Country As String
    Dim v_registrationDate As String
    Dim v_FundSubFund As String
    Dim v_FundSubFundRow As Long 'Fund and Subfund Row in Country sheet
    Dim v_FundSubFundAddress As String
    Dim v_noFundFound As Integer ' If template layout is wrong or Funds not inserted in  _
DETAILED ALL FUNDS sheet, no update will be done and msg box shown to user with advise
    Dim v_CountryName As String 'selects the country name currently to be updated in "detailed   _
_
all funds" sheet
    Dim v_CountryColumnNumber As Long 'selects column number of the country to be updated in  _
order to select the cell
    Dim i As Integer
    Dim v_CellToUpdateAddress As String
 
'Unhide temp sheet
   Sheets("temp").Visible = True
   
' insert concatenation from Fund,subfund,category,class in column A to create unique identifier
    Application.ScreenUpdating = False 'stops flickering
    Worksheets("DETAILED ALL FUNDS").Activate
    ActiveSheet.Outline.ShowLevels RowLevels:=2 ' Ungroup in case sheet is grouped
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "=trim(RC[1])&trim(RC[2])&trim(RC[3])&trim(RC[4])" 'Blanks at the   _
_
beginning and the end of each cell are removed
    Range("A4").Select
    Selection.AutoFill Destination:=Range("A4:A65000"), Type:=xlFillDefault
    Range("A4:A65000").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A4").Select
    Application.CutCopyMode = False

'Clear temp sheet to insert data from Country Sheet
    Worksheets("temp").Activate
    Cells.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    
' Paste Values from Country Sheet into temp Sheet
    'MsgBox UCase(v_SheetName) & " will be updated"
    Sheets(v_SheetName).Select
    Cells.Select
    Selection.Copy
    Range("C4").Select
    Worksheets("temp").Activate
    Sheets("temp").Select
    Cells.Select
    ActiveSheet.Paste
    Range("C4").Select
      
    
' loop trough Funds and Sub Funds until an empty cell is reached
 Do Until IsEmpty(ActiveCell)
    Worksheets("temp").Activate
    
     i = 1 ' to check whether Fund/Subfund level has to be udpated or Fund/Subfund/Category/ _
Class Level
      
' Information from current country sheet selected. This information are used to update the  _
DETAILED ALL FUNDS SHEET
     v_FundSubFund = ActiveCell.Offset(0, 0).Value & ActiveCell.Offset(0, 1).Value
     v_FundSubFundRow = ActiveCell.Row
     v_Country = ActiveCell.Offset(0, -2).Value
     v_registrationDate = ActiveCell.Offset(0, -1).Value
     v_FundSubFundAddress = ActiveCell.Address
     
     Range("E2").Select 'After one fund/subfund has been searched for all Categories, next  _
subfund will be searched and has to start with the first category/class again

' loop through Categories and classes
  Do Until IsEmpty(ActiveCell)

      v_CategoryClass = ActiveCell.Offset(0, 0).Value & ActiveCell.Offset(1, 0).Value
      v_UpdateValue = ActiveCell.Offset(v_FundSubFundRow - 2, 0).Value
      v_CellColorCountrySheet = ActiveCell.Offset(v_FundSubFundRow - 2, 0).Interior.ColorIndex
        
      If i = 1 Then
        v_searchValue = v_FundSubFund
      Else
        v_searchValue = v_FundSubFund & v_CategoryClass
      End If
            
    Worksheets("DETAILED ALL FUNDS").Activate
    Range("A1").Select

'search in DETAILED ALL FUNDS sheet for the value of variable v_searchValue (Fund/Subfund or  _
Fund/Subfund/Category/Class)
On Error Resume Next

Set rCell = Cells.Find(v_searchValue, After:=Cells(1, 1), LookIn:=xlValues)

If Not rCell Is Nothing Then
        v_CellToUpdateAddress = rCell.Address
        v_noFundFound = v_noFundFound + 1 'At least one fund has been found. Therefore increase  _
 _
of variable
        
        Range(v_CellToUpdateAddress).Select
        
        'If i <> 1 Then
        'MsgBox ("Cell " & v_CellToUpdateAddress & " with Fund " & rCell & " has been found") '  _
_
to check which fund has been found
        'End If
        
        ' Select position of country dynamically
        Set rCell = Nothing
        Set rCell = Cells.Find(v_Country, After:=Cells(1, 1), LookIn:=xlValues)
        
        v_CountryName = rCell.Value 'If country to be updated is in detailed all funds sheet,   _
_
select the column number
        v_CountryColumnNumber = rCell.Column

   ' Country to update. case statements below based on sheet "Countries" with list of all  _
countries
        Select Case v_Country
            Case v_CountryName
            ActiveCell.Offset(0, v_CountryColumnNumber - 1).Select ' select the country and  _
jump to the cell (same line, column determined by country name)
        End Select
        
        v_CellToUpdateAddress = ActiveCell.Address
        
        If i = 1 Then
                Sheets("DETAILED ALL FUNDS").Range(v_CellToUpdateAddress).Value =  _
v_registrationDate
            ElseIf v_UpdateValue <> "" Then
                Sheets("DETAILED ALL FUNDS").Range(v_CellToUpdateAddress).Value = v_UpdateValue
                Sheets("DETAILED ALL FUNDS").Range(v_CellToUpdateAddress).Interior.ColorIndex =  _
 _
v_color_index 'Default color per country from country sheet
            Else
                Sheets("DETAILED ALL FUNDS").Range(v_CellToUpdateAddress).Value = v_UpdateValue
                Sheets("DETAILED ALL FUNDS").Range(v_CellToUpdateAddress).Interior.ColorIndex =  _
 _
v_CellColorCountrySheet 'Color from country sheet
        End If

End If
     Worksheets("temp").Activate
     
     If Not i = 1 Then
        ActiveCell.Offset(0, 1).Select ' Loop trough all Categories/Classes
     End If
      
      i = 2 ' increase variable i to get loop now through the categories
     
     Application.StatusBar = "Currently updated: " & v_FundSubFund 'Status Bar
     
     Loop 'inner loop (through categories/classes)
     Range(v_FundSubFundAddress).Select
     ActiveCell.Offset(1, 0).Select 'After all Categories/Classes are checked for one fund/Sub-  _
_
fund go to next Fund/Sub Fund

  Loop 'Outer loop (through funds/subfunds)
  
  ' After all updates done, cleanup
    On Error GoTo 0
    Worksheets("DETAILED ALL FUNDS").Activate
    Columns("A:A").Delete ' Delete Concatenated Column
     
    Columns("F:AH").Select
        With Selection
        .ColumnWidth = 9 ' Column width fixed to 9
        .HorizontalAlignment = xlCenter
        .Font.Name = "Arial Narrow"
        .Font.Size = 8
    End With
     
Range("A1").Select ' back to first cell after all updates

If v_noFundFound = 0 Then
    MsgBox ("Check Template Format or add new Funds to Detailed all Funds Sheets. No Fund has   _
_
been found and nothing has been updated")
Else
    MsgBox ("Update finished for: " & v_SheetName & ". " & v_noFundFound & " cells found and  _
updated according to " & v_SheetName & " sheet")
End If

Sheets("temp").Visible = False 'Hide temp sheet

Worksheets("DETAILED ALL FUNDS").Select

Application.StatusBar = False ' Give Status Bar back to excel
Application.ScreenUpdating = True 'Give control back to excel

End Sub

  

Betrifft: AW: Makro langsam nach erster Ausführung von: Klaus-Dieter
Geschrieben am: 24.02.2010 13:40:30

Hallo,

Select, Activate und Co machen ein Makro nicht gerade schneller. Das solltest du mal als erstes rausschmeißen.



Viele Grüße Klaus-Dieter

Klaus-Dieter's Excel und VBA Seite
Online-Excel



  

Betrifft: AW: Makro langsam nach erster Ausführung von: M.
Geschrieben am: 24.02.2010 14:06:53

Hallo,

danke für den Tip.

Allerdings erklärt das noch nicht warum das Makro beim ersten mal schnell durchläuft und bis zum nächsten Speichern langsam wird.

Gruß,
Achim


  

Betrifft: AW: Makro langsam nach erster Ausführung von: Gerd L
Geschrieben am: 24.02.2010 19:56:14

Hallo Achim!

Allerdings erklärt das noch nicht, ob Du dem Rat von Klaus-Dieter gefolgt bist.
Ich gehe mal davon aus, dass dann so wenig Speicherresourcen benötigt werden, dass Du keinen
Unterschied mehr zwischen erstem u. zweiten Makrodurchlauf feststellst.

Gruß Gerd


  

Betrifft: AW: Makro langsam nach erster Ausführung von: M.
Geschrieben am: 24.02.2010 14:30:35

OT = Ohne text


Beiträge aus den Excel-Beispielen zum Thema "Makro langsam nach erster Ausführung"