VBA Bezug auf Blatt ohne dieses zu aktivieren

[JonasW]

Hallo Excelfreunde,

kurze Frage zum unten stehenden VBA Code. Er dient dazu, ein das Blatt "Auswertung" mit Werten aus anderen Blättern zu aktualisieren. Der Button zum aktivieren liegt allerdings wieder auf einem anderen Blatt. Ich schaffe es leider nicht den Code so umzuschreiben, dass sich das Blatt nicht mehr aktiviert. Wie könnte ich den Code umschreiben?

Danke im Voraus!

Viele Grüße
Jonas

Code:

Private Sub CommandButton2_Click()
Auswertung.Rows("2:65536").ClearContents

'Kopieren von Schlüssel, Projekt, MA und Anteil, wenn MA ausgefüllt'
       n = 2
       m = 2
     
       Do
           If Projektbeteiligte.Cells(n, 3) <> "" And Projektbeteiligte.Cells(n, 4) <> 0 Then
               Projektbeteiligte.Range("A" & n & ":D" & n).Copy
               Auswertung.Range("A" & m & ":D" & m).PasteSpecial xlPasteValues
                   If Auswertung.Cells(m, 1) <> "" Then
                   m = 1 + m
                   End If
           End If
       n = 1 + n
       Loop Until Projektbeteiligte.Cells(n, 1) = ""
   
   
   
   'Übereinsimmenden Schlüssel in Anlehnung an Zeitachse  einfügen'
   
   i = 2
   Do
   n = 2
               Do
                   If Auswertung.Cells(n, 1) = Projektstunden.Cells(i, 1) Then
                       Projektstunden.Range("G" & i & ":CS" & i).Copy
                       Auswertung.Range("E" & n & ":CQ" & n).PasteSpecial xlPasteValues
                               
                               ' MA Anteilig Auswerten'
                               Dim MyRange As Range
                               Dim Cell As Range
                               Set MyRange = Auswertung.Range("E" & n & ":CQ" & n)
                               For Each Cell In MyRange
                                   If Cell.Value <> 0 Then
                                   Cell.Value = (Cell.Value) * (Auswertung.Cells(n, 4).Value)
                                   Cell.Value = Round(Cell.Value, 2)
                                   End If
                               Next Cell
                               
                   End If
                   
               n = 1 + n
               Loop Until Auswertung.Cells(n, 1) = ""

   i = 1 + i
   Loop Until Projektstunden.Cells(i, 1) = ""

Sheets("Tabelle2").PivotTables("PivotTable2").RefreshTable

MsgBox "Berechnung abgeschlossen!"
End Sub

[Steffl]

Hallo Jonas,

das verstehe ich nicht ganz. Dein Code enthält kein einziges Activate oder Select.

[schauan]

Hallo,

wenn der Button zum Aktivieren auf einem anderen Blatt liegt, dann liegt dessen Code auch Dort und Du müsstest uns eventuell den anderen Code posten. Allerdings verstehe ich nicht, wenn Du einen Button zum aktivieren hast, warum der dann nicht mehr aktivieren soll. Oder verstehe ich jetzt etwas falsch ?

[JonasW]

Hallo,

entschuldigt bitte ich war wohl gestern schon etwas durch den Wind. Der Button dient natürlich zum aktualisieren, nicht zum aktivieren.

Ich habe zwei blätter mit Daten: Projektstunden und Projektbeteiligte. Der unten stehende Code fügt die Daten aus diesen Blättern richtig zusammen, sodass ich diese dann per Pivo auswerten kann.

Das Problem ist, der Button zum aktualisieren liegt auf dem Blatt mit der Pivo (der Code steht unten). Und wenn ich den drücke, dann springt er immer zwischen den beiden Blättern hin und her bei jedem Befehl, das schaut nicht schön aus und kostet Zeit.

Ich hoffe alles ist jetzt etwas klarer.

Viele Grüße
Jonas

[RPP63]

Moin!
Es könnte ausreichen, als erste Zeile
Application.ScreenUpdating = False
ins Makro zu schreiben.
Du kannst es als letzte Zeile wieder einschalten, ist aber nicht notwendig, da Excel dies selbständig (auch ohne Code) macht.

Gruß Ralf

[JonasW]

Danke, hat schon funktioniert :). Bei vielen Einträgen ist der Code leider sehr sehr langsam. Wisst ihr vielleicht wie man das ganze schneller gestalten könnte?

[RPP63]

Ja, klar!
Die vielen Zellzugriffe bremsen gehörig.
Ich werde es mir am Wochenende mal genauer anschauen, da müsste einiges gehen.
Vielleicht stellst Du mal eine anonymisierte Beispieldatei ein, die im Aufbau exakt Deinem Original entspricht.
Aber wie gesagt: Heute komme ich nicht mehr dazu.

Gruß Ralf

[JonasW]

Hallo Ralf,

hier die Beispieldatei. Hier sind jetzt 2 "Projekte" enthalten. In der eigentlichen Datei sollen 40-50 Projekte enthalten sein.
Da kommt der Code für die Auswertung schnell an seine Grenzen.

Danke für die Hilfe!

Viele Grüße
Jonas

[atilla]

Hallo zusammen,

wenn ich alles richtig interpretiert habe, dann müsste foilgender Code schneller am Ziel sein:

Code:

Private Sub Worksheet_Activate()
Call mach
End Sub

Sub mach()

 Dim wksBeteiligte As Worksheet
 Dim wksProjektStunden As Worksheet
 
 Dim i As Long, j As Long, k As Long, n As Long, lngZ As Long
 Dim lngAnzahl As Long
 
 Dim x
 Dim ati
 Dim atiBeteiligte
 Dim atiProjektStunden
 Dim arr1(), arr2()
 
 Set wksBeteiligte = Worksheets("Projektbeteiligte")
 Set wksProjektStunden = Worksheets("Projektstunden-LPH")
 
 lngAnzahl = Application.CountIf(wksBeteiligte.Columns("D"), ">0")
   
 lngZ = wksBeteiligte.Cells(wksBeteiligte.Rows.Count, 4).End(xlUp).Row
 atiBeteiligte = wksBeteiligte.Range("A2:D" & lngZ)
 
 lngZ = wksProjektStunden.Cells(wksProjektStunden.Rows.Count, 1).End(xlUp).Row
 atiProjektStunden = wksProjektStunden.Range("A2:CS" & lngZ)

 ReDim arr1(lngAnzahl - 1, 3)
 For i = 1 To UBound(atiBeteiligte)
   If atiBeteiligte(i, 4) <> 0 Then
     For j = 1 To 4
       arr1(n, j - 1) = atiBeteiligte(i, j)
     Next j
     n = n + 1
   End If
 Next i

 n = 0
 ReDim arr2(lngAnzahl - 1, 90)
 For i = 0 To UBound(arr1)
   x = Application.Match(arr1(i, 0), Application.Index(atiProjektStunden, , 1), 0)
   If IsNumeric(x) Then
     For j = 1 To 91
       arr2(n, j - 1) = atiProjektStunden(x, j + 6) * arr1(i, 3)
     Next j
     n = n + 1
   End If
 Next i
 
 Application.ScreenUpdating = False
 Cells.ClearContents
 Range("A2:D2").Resize(n) = arr1
 Range("E2").Resize(n, 91) = arr2
 Application.ScreenUpdating = True

MsgBox "Berechnung abgeschlossen!"
End Sub

Alles Code hinter Tabelle "Auswertung" mit obigem erstzen.

[JonasW]

Vielen Dank! Der Code funktioniert super! Leider hat sich eine Änderung ergeben, sodass der Code mithilfe eines CommandButtons aus einem anderen Blatt gestartet werden soll. Was muss ich ändern, damit er mir die Auswertung nicht auf mein aktuelles Blatt kopiert?