Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
916to920
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
916to920
916to920
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

makro zum auslesen und einfügen von zellenwerten

makro zum auslesen und einfügen von zellenwerten
20.10.2007 11:45:00
zellenwerten
Hallo zusammen,
ich stehe vor folgendem Problem:
Ich habe ein excel-tool erstellt, mit dem ich in einzelnen Tabellenblättern Informationen über verschiedene Projekte sammle, pro Tabellenblatt sind dies in etwa 100 Werte.
Darüber hinaus habe ich ein Übersichtsblatt kreiiert, in welches die einzelnen Daten ausgelesen werden sollen, so dass ich basierend darauf Auswertungen machen kann. In dem Übersichtsblatt werden die Werte des einzelnen Projekts in einer Zeile eingetragen.
Dazu habe ich ein Makro geschrieben, siehe unten. Das Problem ist nun, dass dieses Makro super lange braucht. Ich möchte es wenn irgendwie möglich schneller machen und hoffe ihr könnt mir helfen.
Herzlichen Dank,
Tillmann

Private Sub CommandButton2_Click()
Dim text As String
Dim i, j As Integer 'Anzahl_Tabellenblätter  dient mir zum zählen der Anzahl Tabellenblätter
'die ersten 3 Tabellenblätter müssen unberührt bleiben!
i = 4 ' die ersten drei Tabellenblätter sollen unberührt bleiben, weil sie keine Übersicht sind
j = 23 'benötige ich zum zählen der zeilen in Übersichtsblatt
With Application
.ScreenUpdating = False
End With
With Sheets("Übersicht")
.Range("C23") = 1
.Range("B23:FG100").SpecialCells(xlCellTypeConstants).ClearContents
End With
Do While i 


10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: makro zum auslesen und einfügen von zellenwerten
20.10.2007 11:58:00
zellenwerten
Hallo Fetzer, (fiese Eltern)
durch die "wirre" verteilung der auszulesenden zeilen, kann man da wohl nicht viel machen, aber vielleicht hilft es, wenn man Excel für die Zeit "lahmlegt".
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub CommandButton2_Click()

Dim text As String
Dim i, j As Integer 'Anzahl_Tabellenblätter dient mir zum zählen der Anzahl Tabellenblätter
'die ersten 3 Tabellenblätter müssen unberührt bleiben!

i = 4 ' die ersten drei Tabellenblätter sollen unberührt bleiben, weil sie keine Übersicht sind
j = 23 'benötige ich zum zählen der zeilen in Übersichtsblatt


On Error GoTo ErrExit
GMS

With Sheets("Übersicht")
    .Range("C23") = 1
    .Range("B23:FG100").SpecialCells(xlCellTypeConstants).ClearContents
End With

Do While i < Sheets.Count
    
    Sheets("Übersicht").Cells(j, 3) = Sheets(i).Range("B2") 'Projekt-Name
    Sheets("Übersicht").Cells(j, 4) = Sheets(i).Range("B3") 'Projekt-Leiter
    'Sheets("Übersicht").Cells(j, 4) = Sheets(i).Range("B4") 'involvierte Abteilungen
    Sheets("Übersicht").Cells(j, 9) = Sheets(i).Range("F3") 'commodity
    Sheets("Übersicht").Cells(j, 10) = Sheets(i).Range("K3") 'Mat.-Gr.
    Sheets("Übersicht").Cells(j, 11) = Sheets(i).Range("K4") 'SD.-K.
    
    Sheets("Übersicht").Cells(j, 5) = Sheets(i).Range("D8") 'Meilenst.
    Sheets("Übersicht").Cells(j, 6) = Sheets(i).Range("A8") 'montär im Plan
    Sheets("Übersicht").Cells(j, 7) = Sheets(i).Range("B8") 'terminlich im Plan
    Sheets("Übersicht").Range("O" & j) = Sheets(i).Range("U18") 'Wahrscheinlichkeit Ist
    Sheets("Übersicht").Range("P" & j) = Sheets(i).Range("C18") 'Wahrscheinlichkeit Plan
    
    Sheets("Übersicht").Range("AA" & j) = Sheets(i).Range("U20") 'Datum ppv ist
    Sheets("Übersicht").Range("AC" & j) = Sheets(i).Range("C20") 'Datum ppv plan
    Sheets("Übersicht").Range("AG" & j) = Sheets(i).Range("U23") 'Datum step ist
    Sheets("Übersicht").Range("AH" & j) = Sheets(i).Range("C23") 'Datum step plan
    Sheets("Übersicht").Range("AK" & j) = Sheets(i).Range("U26") 'Datum oss ist
    Sheets("Übersicht").Range("AM" & j) = Sheets(i).Range("C26") 'Datum oss plan
    Sheets("Übersicht").Range("Q" & j) = Sheets(i).Range("U15") 'datum pot. savings ist
    Sheets("Übersicht").Range("S" & j) = Sheets(i).Range("C15") 'Datum pot. savings plan
    'doppelt
    'Sheets("Übersicht").Range("AK" & j) = Sheets(i).Range("U26") 'datum oss ist
    'Sheets("Übersicht").Range("AM" & j) = Sheets(i).Range("C26") 'datum oss plan
    Sheets("Übersicht").Range("L" & j) = Sheets(i).Range("AB10") 'datum ist datum
    
    
    Sheets("Übersicht").Range("AQ" & j) = Sheets(i).Range("W31") 'notwendiges budget in 2007 ist
    Sheets("Übersicht").Range("AR" & j) = Sheets(i).Range("D31") 'notwendiges budget in 2007 plan
    Sheets("Übersicht").Range("AS" & j) = Sheets(i).Range("Y31") 'notwendiges budget in 2008 ist
    Sheets("Übersicht").Range("AT" & j) = Sheets(i).Range("E31") 'notwendiges budget in 2008 plan
    Sheets("Übersicht").Range("AU" & j) = Sheets(i).Range("AA31") 'notwendiges budget in 2009 ist
    Sheets("Übersicht").Range("AV" & j) = Sheets(i).Range("G31") 'notwendiges budget in 2009 plan
    Sheets("Übersicht").Range("AW" & j) = Sheets(i).Range("AC31") 'notwendiges budget in 2010 ist
    Sheets("Übersicht").Range("AX" & j) = Sheets(i).Range("I31") 'notwendiges budget in 2010 plan
    
    Sheets("Übersicht").Range("AY" & j) = Sheets(i).Range("W34") 'ressourcen bedarf strat. 2007 ist
    Sheets("Übersicht").Range("FD" & j) = Sheets(i).Range("D34") 'plan
    Sheets("Übersicht").Range("BA" & j) = Sheets(i).Range("Y34") 'ressourcen bedarf strat. 2008 ist
    Sheets("Übersicht").Range("FF" & j) = Sheets(i).Range("E34") 'plan
    Sheets("Übersicht").Range("BC" & j) = Sheets(i).Range("AA34") 'ressourcen bedarf strat. 2009 _
        ist

    Sheets("Übersicht").Range("FH" & j) = Sheets(i).Range("G34") ' plan
    Sheets("Übersicht").Range("BE" & j) = Sheets(i).Range("AC34") 'ressourcen bedarf strat. 2010 _
        ist

    Sheets("Übersicht").Range("FJ" & j) = Sheets(i).Range("I34") ' plan
    
    Sheets("Übersicht").Range("AZ" & j) = Sheets(i).Range("W35") 'ressourcen bedarf takt. 2007 ist
    Sheets("Übersicht").Range("FE" & j) = Sheets(i).Range("D35") 'plan
    Sheets("Übersicht").Range("BB" & j) = Sheets(i).Range("Y35") 'ressourcen bedarf takt. 2008 ist
    Sheets("Übersicht").Range("FG" & j) = Sheets(i).Range("E35") 'plan
    Sheets("Übersicht").Range("BD" & j) = Sheets(i).Range("AA35") 'ressourcen bedarf takt. 2009 ist
    Sheets("Übersicht").Range("FI" & j) = Sheets(i).Range("G35") ' plan
    Sheets("Übersicht").Range("BE" & j) = Sheets(i).Range("AC35") 'ressourcen bedarf takt. 2010 ist
    Sheets("Übersicht").Range("FK" & j) = Sheets(i).Range("I35") ' plan
    
    
    Sheets("Übersicht").Range("DU" & j) = Sheets(i).Range("D13") 'betroffenes PVO Plan DD Heavy
    Sheets("Übersicht").Range("DT" & j) = Sheets(i).Range("W13") 'betroffenes PVO Ist DD Heavy
    Sheets("Übersicht").Range("DQ" & j) = Sheets(i).Range("D15") 'pot. savings ungew. Plan
    Sheets("Übersicht").Range("DP" & j) = Sheets(i).Range("W15") 'pot. savings ungew.Ist
    Sheets("Übersicht").Range("DV" & j) = Sheets(i).Range("W20") 'PPV value ISt
    Sheets("Übersicht").Range("DW" & j) = Sheets(i).Range("D20") 'PPV value Plan
    Sheets("Übersicht").Range("DZ" & j) = Sheets(i).Range("W23") 'STEP ungew. ISt
    Sheets("Übersicht").Range("EA" & j) = Sheets(i).Range("D23") 'Step ungew. Plan
    Sheets("Übersicht").Range("ED" & j) = Sheets(i).Range("D26") 'OSS Ist ungew.
    Sheets("Übersicht").Range("EE" & j) = Sheets(i).Range("W26") 'OSS Plan ungew.
    
    Sheets("Übersicht").Range("DA" & j) = Sheets(i).Range("E13") 'betroffenes PVO Plan DD Small
    Sheets("Übersicht").Range("CZ" & j) = Sheets(i).Range("Y13") 'betroffenes PVO Ist DD Small
    Sheets("Übersicht").Range("CV" & j) = Sheets(i).Range("Y15") 'pot. Savings Ist DD Small
    Sheets("Übersicht").Range("CW" & j) = Sheets(i).Range("E15") 'pot. Savings Plan DD Small
    Sheets("Übersicht").Range("DB" & j) = Sheets(i).Range("Y20") 'ungew. PPV Ist DD Small
    Sheets("Übersicht").Range("DC" & j) = Sheets(i).Range("E20") 'ungew. PPV Plan DD Small
    Sheets("Übersicht").Range("DF" & j) = Sheets(i).Range("Y23") 'ungew. Step Ist DD Small
    Sheets("Übersicht").Range("DG" & j) = Sheets(i).Range("E23") 'ungew. Step Plan DD Small
    Sheets("Übersicht").Range("DJ" & j) = Sheets(i).Range("Y26") 'ungew. OSS ISt DD Small
    Sheets("Übersicht").Range("DK" & j) = Sheets(i).Range("E26") 'ungew. OSS Plan DD Small
    
    Sheets("Übersicht").Range("BL" & j) = Sheets(i).Range("AA13") 'betroffenes PVO Ist Df
    Sheets("Übersicht").Range("BM" & j) = Sheets(i).Range("G13") 'betroffenes PVO Plan Df
    Sheets("Übersicht").Range("BH" & j) = Sheets(i).Range("AA15") 'pot. Savings Ist
    Sheets("Übersicht").Range("BI" & j) = Sheets(i).Range("G15") 'pot. Savings Plan
    Sheets("Übersicht").Range("BN" & j) = Sheets(i).Range("AA20") 'ungew. PPV Ist
    Sheets("Übersicht").Range("BO" & j) = Sheets(i).Range("Y20") 'ungew. PPV Plan
    Sheets("Übersicht").Range("BR" & j) = Sheets(i).Range("AA23") 'ungew. Step Ist
    Sheets("Übersicht").Range("BS" & j) = Sheets(i).Range("G23") 'ungew. Step Plan
    Sheets("Übersicht").Range("BV" & j) = Sheets(i).Range("AA26") 'ungew. OSS ISt
    Sheets("Übersicht").Range("BW" & j) = Sheets(i).Range("G26") 'ungew. OSS Plan
    
    Sheets("Übersicht").Range("CF" & j) = Sheets(i).Range("AC13") 'betroffenes PVO Ist Dia
    Sheets("Übersicht").Range("CG" & j) = Sheets(i).Range("I13") 'betroffenes PVO Plan Dia
    Sheets("Übersicht").Range("CB" & j) = Sheets(i).Range("AC15") 'pot. Savings Ist
    Sheets("Übersicht").Range("CC" & j) = Sheets(i).Range("I15") 'pot. Savings Plan
    Sheets("Übersicht").Range("CH" & j) = Sheets(i).Range("AC20") 'ungew. PPV Ist
    Sheets("Übersicht").Range("CI" & j) = Sheets(i).Range("I20") 'ungew. PPV Plan
    Sheets("Übersicht").Range("CL" & j) = Sheets(i).Range("AC23") 'ungew. Step Ist
    Sheets("Übersicht").Range("CM" & j) = Sheets(i).Range("I23") 'ungew. Step Plan
    Sheets("Übersicht").Range("CP" & j) = Sheets(i).Range("AC26") 'ungew. OSS ISt
    Sheets("Übersicht").Range("CQ" & j) = Sheets(i).Range("I26") 'ungew. OSS Plan
    
    Sheets("Übersicht").Range("EN" & j) = Sheets(i).Range("AE13") 'betroffenes PVO Ist Meas.
    Sheets("Übersicht").Range("EO" & j) = Sheets(i).Range("K13") 'betroffenes PVO Plan Meas.
    Sheets("Übersicht").Range("EJ" & j) = Sheets(i).Range("AE15") 'pot. Savings Ist
    Sheets("Übersicht").Range("EK" & j) = Sheets(i).Range("K15") 'pot. Savings Plan
    Sheets("Übersicht").Range("EP" & j) = Sheets(i).Range("AE20") 'ungew. PPV Ist
    Sheets("Übersicht").Range("EQ" & j) = Sheets(i).Range("K20") 'ungew. PPV Plan
    Sheets("Übersicht").Range("ET" & j) = Sheets(i).Range("AE23") 'ungew. Step Ist
    Sheets("Übersicht").Range("EU" & j) = Sheets(i).Range("K23") 'ungew. Step Plan
    Sheets("Übersicht").Range("EX" & j) = Sheets(i).Range("AE26") 'ungew. OSS ISt
    Sheets("Übersicht").Range("EY" & j) = Sheets(i).Range("K26") 'ungew. OSS Plan
    
    
    
    i = i + 1
    j = j + 1
    
Loop


ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
Range("B16").EntireRow.Hidden = True
Selection.AutoFilter Field:=2, Criteria1:=1

ErrExit:
GMS True
End Sub

Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long

With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Modus Then
        .Calculation = lngCalc
    Else
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End If
    .Cursor = IIf(Modus, -4143, 2)
    .CutCopyMode = False
End With

End Sub

Gruß Sepp

Anzeige
AW: makro zum auslesen und einfügen von zellenwert
20.10.2007 13:48:00
zellenwert
Hallo Sepp,
danke für deinen Hinweis. Ich hatte versehentlich 2mal gepostet.
Den Code habe ich versucht, es wird zum einen zwar nicht schneller.
Außerdem kommt ein Laufzeit-fehler, in der Zeile:
If Modus Then
.Calculation = lngCalc
des GMS moduls.
Wie akiviere ich denn Excel nun wieder, weil meine Maus bspw. nur noch die Sanduhr zeigt.
Gruß,tillmann

AW: makro zum auslesen und einfügen von zellenwert
20.10.2007 13:54:26
zellenwert
Hallo Tillmann,
eigenartig, diese Funktion verwende ich sehr oft und hatte damit eigentlich noch nie Probleme.
Gib ins Direktfenster mal

GMS True


ein und drücke ENTER.

Gruß Sepp

Anzeige
AW: makro zum auslesen und einfügen von zellenwert
20.10.2007 14:11:41
zellenwert
Hallo Sepp,
jetzt lief die Funktion ohne Fehler.
Schneller wird es leider trotzdem nicht.
Wodurch könnte ich dies aber letztlich doch schneller bekommen?
Ich bin echt am verzweifeln.
Gruß,
tillmann

AW: makro zum auslesen und einfügen von zellenwert
20.10.2007 14:32:00
zellenwert
Hallo Tillmann,
wie immer :-)
Dem Rechner zwischendurch eine Pause gönnen,
falls im Modul u. den Sheets häufig Änderungen vorgenommen worden sind, die ganze Sache in ein neues Workbook kopieren,
einheitliche Verwendung der Cells-Schreibweise,
strukturierter Codeaufbau, wenn möglich Zuweisung der Werte in Blöcken,
setzen von Objektverweisen.
Gruß Gerd

Anzeige
AW: makro zum auslesen und einfügen von zellenwert
20.10.2007 14:43:39
zellenwert
Hallo Tillman,
Probier mal an einer Testmappe.
Ich hoffe, das ich alles richtig zugeordnet habe.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit



Private Sub CommandButton2_Click()
Dim a As Variant
Dim text As String
Dim i, j As Integer 'Anzahl_Tabellenblätter dient mir zum zählen der Anzahl Tabellenblätter
'die ersten 3 Tabellenblätter müssen unberührt bleiben!

i = 4 ' die ersten drei Tabellenblätter sollen unberührt bleiben, weil sie keine Übersicht sind
j = 1 'benötige ich zum zählen der zeilen in Übersichtsblatt


On Error GoTo ErrExit
GMS

With Sheets("Übersicht")
    .Range("C23") = 1
    .Range("B23:FG100").SpecialCells(xlCellTypeConstants).ClearContents
    a = .Range("B23:FG100")
End With

Do While i < Sheets.Count
    
    a(j, 1) = Sheets(i).Range("B2") 'Projekt-Name
    a(j, 3) = Sheets(i).Range("B3") 'Projekt-Leiter
    'a(j, 3) = Sheets(i).Range("B4") 'involvierte Abteilungen
    a(j, 8) = Sheets(i).Range("F3") 'commodity
    a(j, 9) = Sheets(i).Range("K3") 'Mat.-Gr.
    a(j, 10) = Sheets(i).Range("K4") 'SD.-K.
    
    a(j, 4) = Sheets(i).Range("D8") 'Meilenst.
    a(j, 5) = Sheets(i).Range("A8") 'montär im Plan
    a(j, 6) = Sheets(i).Range("B8") 'terminlich im Plan
    a(j, 14) = Sheets(i).Range("U18") 'Wahrscheinlichkeit Ist
    a(j, 15) = Sheets(i).Range("C18") 'Wahrscheinlichkeit Plan
    
    a(j, 26) = Sheets(i).Range("U20") 'Datum ppv ist
    a(j, 28) = Sheets(i).Range("C20") 'Datum ppv plan
    a(j, 32) = Sheets(i).Range("U23") 'Datum step ist
    a(j, 33) = Sheets(i).Range("C23") 'Datum step plan
    a(j, 36) = Sheets(i).Range("U26") 'Datum oss ist
    a(j, 38) = Sheets(i).Range("C26") 'Datum oss plan
    a(j, 16) = Sheets(i).Range("U15") 'datum pot. savings ist
    a(j, 18) = Sheets(i).Range("C15") 'Datum pot. savings plan
    a(j, 11) = Sheets(i).Range("AB10") 'datum ist datum
    
    
    a(j, 42) = Sheets(i).Range("W31") 'notwendiges budget in 2007 ist
    a(j, 43) = Sheets(i).Range("D31") 'notwendiges budget in 2007 plan
    a(j, 44) = Sheets(i).Range("Y31") 'notwendiges budget in 2008 ist
    a(j, 45) = Sheets(i).Range("E31") 'notwendiges budget in 2008 plan
    a(j, 46) = Sheets(i).Range("AA31") 'notwendiges budget in 2009 ist
    a(j, 47) = Sheets(i).Range("G31") 'notwendiges budget in 2009 plan
    a(j, 48) = Sheets(i).Range("AC31") 'notwendiges budget in 2010 ist
    a(j, 49) = Sheets(i).Range("I31") 'notwendiges budget in 2010 plan
    
    a(j, 50) = Sheets(i).Range("W34") 'ressourcen bedarf strat. 2007 ist
    a(j, 159) = Sheets(i).Range("D34") 'plan
    a(j, 52) = Sheets(i).Range("Y34") 'ressourcen bedarf strat. 2008 ist
    a(j, 161) = Sheets(i).Range("E34") 'plan
    a(j, 54) = Sheets(i).Range("AA34") 'ressourcen bedarf strat. 2009 _
        ist

    a(j, 163) = Sheets(i).Range("G34") ' plan
    a(j, 56) = Sheets(i).Range("AC34") 'ressourcen bedarf strat. 2010 _
        ist

    a(j, 165) = Sheets(i).Range("I34") ' plan
    
    a(j, 51) = Sheets(i).Range("W35") 'ressourcen bedarf takt. 2007 ist
    a(j, 160) = Sheets(i).Range("D35") 'plan
    a(j, 53) = Sheets(i).Range("Y35") 'ressourcen bedarf takt. 2008 ist
    a(j, 162) = Sheets(i).Range("E35") 'plan
    a(j, 55) = Sheets(i).Range("AA35") 'ressourcen bedarf takt. 2009 ist
    a(j, 164) = Sheets(i).Range("G35") ' plan
    a(j, 56) = Sheets(i).Range("AC35") 'ressourcen bedarf takt. 2010 ist
    a(j, 166) = Sheets(i).Range("I35") ' plan
    
    
    a(j, 124) = Sheets(i).Range("D13") 'betroffenes PVO Plan DD Heavy
    a(j, 123) = Sheets(i).Range("W13") 'betroffenes PVO Ist DD Heavy
    a(j, 120) = Sheets(i).Range("D15") 'pot. savings ungew. Plan
    a(j, 119) = Sheets(i).Range("W15") 'pot. savings ungew.Ist
    a(j, 125) = Sheets(i).Range("W20") 'PPV value ISt
    a(j, 126) = Sheets(i).Range("D20") 'PPV value Plan
    a(j, 129) = Sheets(i).Range("W23") 'STEP ungew. ISt
    a(j, 130) = Sheets(i).Range("D23") 'Step ungew. Plan
    a(j, 133) = Sheets(i).Range("D26") 'OSS Ist ungew.
    a(j, 134) = Sheets(i).Range("W26") 'OSS Plan ungew.
    
    a(j, 104) = Sheets(i).Range("E13") 'betroffenes PVO Plan DD Small
    a(j, 103) = Sheets(i).Range("Y13") 'betroffenes PVO Ist DD Small
    a(j, 99) = Sheets(i).Range("Y15") 'pot. Savings Ist DD Small
    a(j, 100) = Sheets(i).Range("E15") 'pot. Savings Plan DD Small
    a(j, 105) = Sheets(i).Range("Y20") 'ungew. PPV Ist DD Small
    a(j, 106) = Sheets(i).Range("E20") 'ungew. PPV Plan DD Small
    a(j, 109) = Sheets(i).Range("Y23") 'ungew. Step Ist DD Small
    a(j, 110) = Sheets(i).Range("E23") 'ungew. Step Plan DD Small
    a(j, 113) = Sheets(i).Range("Y26") 'ungew. OSS ISt DD Small
    a(j, 114) = Sheets(i).Range("E26") 'ungew. OSS Plan DD Small
    
    a(j, 63) = Sheets(i).Range("AA13") 'betroffenes PVO Ist Df
    a(j, 64) = Sheets(i).Range("G13") 'betroffenes PVO Plan Df
    a(j, 59) = Sheets(i).Range("AA15") 'pot. Savings Ist
    a(j, 60) = Sheets(i).Range("G15") 'pot. Savings Plan
    a(j, 65) = Sheets(i).Range("AA20") 'ungew. PPV Ist
    a(j, 66) = Sheets(i).Range("Y20") 'ungew. PPV Plan
    a(j, 69) = Sheets(i).Range("AA23") 'ungew. Step Ist
    a(j, 70) = Sheets(i).Range("G23") 'ungew. Step Plan
    a(j, 73) = Sheets(i).Range("AA26") 'ungew. OSS ISt
    a(j, 74) = Sheets(i).Range("G26") 'ungew. OSS Plan
    
    a(j, 83) = Sheets(i).Range("AC13") 'betroffenes PVO Ist Dia
    a(j, 84) = Sheets(i).Range("I13") 'betroffenes PVO Plan Dia
    a(j, 79) = Sheets(i).Range("AC15") 'pot. Savings Ist
    a(j, 80) = Sheets(i).Range("I15") 'pot. Savings Plan
    a(j, 85) = Sheets(i).Range("AC20") 'ungew. PPV Ist
    a(j, 86) = Sheets(i).Range("I20") 'ungew. PPV Plan
    a(j, 89) = Sheets(i).Range("AC23") 'ungew. Step Ist
    a(j, 90) = Sheets(i).Range("I23") 'ungew. Step Plan
    a(j, 93) = Sheets(i).Range("AC26") 'ungew. OSS ISt
    a(j, 94) = Sheets(i).Range("I26") 'ungew. OSS Plan
    
    a(j, 143) = Sheets(i).Range("AE13") 'betroffenes PVO Ist Meas.
    a(j, 144) = Sheets(i).Range("K13") 'betroffenes PVO Plan Meas.
    a(j, 139) = Sheets(i).Range("AE15") 'pot. Savings Ist
    a(j, 140) = Sheets(i).Range("K15") 'pot. Savings Plan
    a(j, 145) = Sheets(i).Range("AE20") 'ungew. PPV Ist
    a(j, 146) = Sheets(i).Range("K20") 'ungew. PPV Plan
    a(j, 149) = Sheets(i).Range("AE23") 'ungew. Step Ist
    a(j, 150) = Sheets(i).Range("K23") 'ungew. Step Plan
    a(j, 153) = Sheets(i).Range("AE26") 'ungew. OSS ISt
    a(j, 154) = Sheets(i).Range("K26") 'ungew. OSS Plan
    
    
    
    i = i + 1
    j = j + 1
    
Loop

Sheets("Übersicht").Range("B23:FG100") = a

ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
Range("B16").EntireRow.Hidden = True
Selection.AutoFilter Field:=2, Criteria1:=1

ErrExit:
GMS True
End Sub

Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long

With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Modus Then
        .Calculation = lngCalc
    Else
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End If
    .Cursor = IIf(Modus, -4143, 2)
    .CutCopyMode = False
End With

End Sub

Gruß Sepp

Anzeige
AW: makro zum auslesen und einfügen von zellenwert
21.10.2007 11:15:52
zellenwert
Hallo Sepp,
das hat jetzt lange gedauert mit meiner Antwort.
Die Funktion ist eine interessante Möglichkeit, klappt aber leider nicht einwandfrei.
Irgendwie schreibt es mir die Werte ziemlich wahllos in meine Felder und dabei auch mehrmals.
Ich kann noch nicht erkennen, nach welcher Logik das geschieht.
Desweiteren würde mich noch interessieren, wie man mit dieser Formel vermeiden kann, dass Formeln, welche im Übersichtstabellen-Blatt in einzelnen Zellen eingetragen sind, nicht überschrieben werden durch das Makro.
Herzliche Grüße und einen schönen Sonntag,
tillmann

Anzeige
AW: makro zum auslesen und einfügen von zellenwert
21.10.2007 11:34:12
zellenwert
Hallo Tillmann,
bei der Zuordnung kann mir schon der ein oder andere Fehler unterlaufen sein. Das musst du halt korrigieren.
Die Formeln sollten so erhalten bleiben.
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Sub CommandButton2_Click()
Dim a As Variant
Dim text As String
Dim i, j As Integer 'Anzahl_Tabellenblätter dient mir zum zählen der Anzahl Tabellenblätter
'die ersten 3 Tabellenblätter müssen unberührt bleiben!

i = 4 ' die ersten drei Tabellenblätter sollen unberührt bleiben, weil sie keine Übersicht sind
j = 1 'benötige ich zum zählen der zeilen in Übersichtsblatt


On Error GoTo ErrExit
GMS

With Sheets("Übersicht")
    .Range("C23") = 1
    .Range("B23:FG100").SpecialCells(xlCellTypeConstants).ClearContents
    a = .Range("B23:FG100").Formula
End With

Do While i < Sheets.Count
    
    a(j, 1) = Sheets(i).Range("B2") 'Projekt-Name
    a(j, 3) = Sheets(i).Range("B3") 'Projekt-Leiter
    'a(j, 3) = Sheets(i).Range("B4") 'involvierte Abteilungen
    a(j, 8) = Sheets(i).Range("F3") 'commodity
    a(j, 9) = Sheets(i).Range("K3") 'Mat.-Gr.
    a(j, 10) = Sheets(i).Range("K4") 'SD.-K.
    
    a(j, 4) = Sheets(i).Range("D8") 'Meilenst.
    a(j, 5) = Sheets(i).Range("A8") 'montär im Plan
    a(j, 6) = Sheets(i).Range("B8") 'terminlich im Plan
    a(j, 14) = Sheets(i).Range("U18") 'Wahrscheinlichkeit Ist
    a(j, 15) = Sheets(i).Range("C18") 'Wahrscheinlichkeit Plan
    
    a(j, 26) = Sheets(i).Range("U20") 'Datum ppv ist
    a(j, 28) = Sheets(i).Range("C20") 'Datum ppv plan
    a(j, 32) = Sheets(i).Range("U23") 'Datum step ist
    a(j, 33) = Sheets(i).Range("C23") 'Datum step plan
    a(j, 36) = Sheets(i).Range("U26") 'Datum oss ist
    a(j, 38) = Sheets(i).Range("C26") 'Datum oss plan
    a(j, 16) = Sheets(i).Range("U15") 'datum pot. savings ist
    a(j, 18) = Sheets(i).Range("C15") 'Datum pot. savings plan
    a(j, 11) = Sheets(i).Range("AB10") 'datum ist datum
    
    
    a(j, 42) = Sheets(i).Range("W31") 'notwendiges budget in 2007 ist
    a(j, 43) = Sheets(i).Range("D31") 'notwendiges budget in 2007 plan
    a(j, 44) = Sheets(i).Range("Y31") 'notwendiges budget in 2008 ist
    a(j, 45) = Sheets(i).Range("E31") 'notwendiges budget in 2008 plan
    a(j, 46) = Sheets(i).Range("AA31") 'notwendiges budget in 2009 ist
    a(j, 47) = Sheets(i).Range("G31") 'notwendiges budget in 2009 plan
    a(j, 48) = Sheets(i).Range("AC31") 'notwendiges budget in 2010 ist
    a(j, 49) = Sheets(i).Range("I31") 'notwendiges budget in 2010 plan
    
    a(j, 50) = Sheets(i).Range("W34") 'ressourcen bedarf strat. 2007 ist
    a(j, 159) = Sheets(i).Range("D34") 'plan
    a(j, 52) = Sheets(i).Range("Y34") 'ressourcen bedarf strat. 2008 ist
    a(j, 161) = Sheets(i).Range("E34") 'plan
    a(j, 54) = Sheets(i).Range("AA34") 'ressourcen bedarf strat. 2009 _
        ist

    a(j, 163) = Sheets(i).Range("G34") ' plan
    a(j, 56) = Sheets(i).Range("AC34") 'ressourcen bedarf strat. 2010 _
        ist

    a(j, 165) = Sheets(i).Range("I34") ' plan
    
    a(j, 51) = Sheets(i).Range("W35") 'ressourcen bedarf takt. 2007 ist
    a(j, 160) = Sheets(i).Range("D35") 'plan
    a(j, 53) = Sheets(i).Range("Y35") 'ressourcen bedarf takt. 2008 ist
    a(j, 162) = Sheets(i).Range("E35") 'plan
    a(j, 55) = Sheets(i).Range("AA35") 'ressourcen bedarf takt. 2009 ist
    a(j, 164) = Sheets(i).Range("G35") ' plan
    a(j, 56) = Sheets(i).Range("AC35") 'ressourcen bedarf takt. 2010 ist
    a(j, 166) = Sheets(i).Range("I35") ' plan
    
    
    a(j, 124) = Sheets(i).Range("D13") 'betroffenes PVO Plan DD Heavy
    a(j, 123) = Sheets(i).Range("W13") 'betroffenes PVO Ist DD Heavy
    a(j, 120) = Sheets(i).Range("D15") 'pot. savings ungew. Plan
    a(j, 119) = Sheets(i).Range("W15") 'pot. savings ungew.Ist
    a(j, 125) = Sheets(i).Range("W20") 'PPV value ISt
    a(j, 126) = Sheets(i).Range("D20") 'PPV value Plan
    a(j, 129) = Sheets(i).Range("W23") 'STEP ungew. ISt
    a(j, 130) = Sheets(i).Range("D23") 'Step ungew. Plan
    a(j, 133) = Sheets(i).Range("D26") 'OSS Ist ungew.
    a(j, 134) = Sheets(i).Range("W26") 'OSS Plan ungew.
    
    a(j, 104) = Sheets(i).Range("E13") 'betroffenes PVO Plan DD Small
    a(j, 103) = Sheets(i).Range("Y13") 'betroffenes PVO Ist DD Small
    a(j, 99) = Sheets(i).Range("Y15") 'pot. Savings Ist DD Small
    a(j, 100) = Sheets(i).Range("E15") 'pot. Savings Plan DD Small
    a(j, 105) = Sheets(i).Range("Y20") 'ungew. PPV Ist DD Small
    a(j, 106) = Sheets(i).Range("E20") 'ungew. PPV Plan DD Small
    a(j, 109) = Sheets(i).Range("Y23") 'ungew. Step Ist DD Small
    a(j, 110) = Sheets(i).Range("E23") 'ungew. Step Plan DD Small
    a(j, 113) = Sheets(i).Range("Y26") 'ungew. OSS ISt DD Small
    a(j, 114) = Sheets(i).Range("E26") 'ungew. OSS Plan DD Small
    
    a(j, 63) = Sheets(i).Range("AA13") 'betroffenes PVO Ist Df
    a(j, 64) = Sheets(i).Range("G13") 'betroffenes PVO Plan Df
    a(j, 59) = Sheets(i).Range("AA15") 'pot. Savings Ist
    a(j, 60) = Sheets(i).Range("G15") 'pot. Savings Plan
    a(j, 65) = Sheets(i).Range("AA20") 'ungew. PPV Ist
    a(j, 66) = Sheets(i).Range("Y20") 'ungew. PPV Plan
    a(j, 69) = Sheets(i).Range("AA23") 'ungew. Step Ist
    a(j, 70) = Sheets(i).Range("G23") 'ungew. Step Plan
    a(j, 73) = Sheets(i).Range("AA26") 'ungew. OSS ISt
    a(j, 74) = Sheets(i).Range("G26") 'ungew. OSS Plan
    
    a(j, 83) = Sheets(i).Range("AC13") 'betroffenes PVO Ist Dia
    a(j, 84) = Sheets(i).Range("I13") 'betroffenes PVO Plan Dia
    a(j, 79) = Sheets(i).Range("AC15") 'pot. Savings Ist
    a(j, 80) = Sheets(i).Range("I15") 'pot. Savings Plan
    a(j, 85) = Sheets(i).Range("AC20") 'ungew. PPV Ist
    a(j, 86) = Sheets(i).Range("I20") 'ungew. PPV Plan
    a(j, 89) = Sheets(i).Range("AC23") 'ungew. Step Ist
    a(j, 90) = Sheets(i).Range("I23") 'ungew. Step Plan
    a(j, 93) = Sheets(i).Range("AC26") 'ungew. OSS ISt
    a(j, 94) = Sheets(i).Range("I26") 'ungew. OSS Plan
    
    a(j, 143) = Sheets(i).Range("AE13") 'betroffenes PVO Ist Meas.
    a(j, 144) = Sheets(i).Range("K13") 'betroffenes PVO Plan Meas.
    a(j, 139) = Sheets(i).Range("AE15") 'pot. Savings Ist
    a(j, 140) = Sheets(i).Range("K15") 'pot. Savings Plan
    a(j, 145) = Sheets(i).Range("AE20") 'ungew. PPV Ist
    a(j, 146) = Sheets(i).Range("K20") 'ungew. PPV Plan
    a(j, 149) = Sheets(i).Range("AE23") 'ungew. Step Ist
    a(j, 150) = Sheets(i).Range("K23") 'ungew. Step Plan
    a(j, 153) = Sheets(i).Range("AE26") 'ungew. OSS ISt
    a(j, 154) = Sheets(i).Range("K26") 'ungew. OSS Plan
    
    
    
    i = i + 1
    j = j + 1
    
Loop

Sheets("Übersicht").Range("B23:FG100").Formula = a

ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
Range("B16").EntireRow.Hidden = True
Selection.AutoFilter Field:=2, Criteria1:=1

ErrExit:
GMS True
End Sub

Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long

With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Modus Then
        .Calculation = lngCalc
    Else
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End If
    .Cursor = IIf(Modus, -4143, 2)
    .CutCopyMode = False
End With

End Sub

Gruß Sepp

Anzeige
AW: makro zum auslesen und einfügen von zellenwert
22.10.2007 22:40:25
zellenwert
Hallo Sepp, hallo alle anderen interessierten Leser,
die Idee die Werte in einen Array zu übertragen und diesen dann einzufügen auf einmal in den Zellbereich hat geklappt.
Allerdings erst nachdem ich folgenden Fehler beseitigt hatte:
Ich habe in meinem Übersichts-blatt FIlter gesetzt. Waren diese aktiv so wurden die Werte aus dem Array nie richtig in das Blatt übertragen.
Waren die Filter deaktiviert, und somit der gesamte Zellbereich aktiv, wurden die Werte 1:1 so eingefügt, wie diese im Array gespeichert waren.
Danke nochmal Sepp für deinen Input.
Liebe Grüße,
tillmann

Anzeige
Frage
22.10.2007 22:45:00
Josef
Hallo Tillmann,
und wie sieht's jetzt mit der Geschwindigkeit aus?
Gruß Sepp

308 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige