Thema Datum  Von Nutzer Rating
Antwort
Rot Makro für Tabellenkomination funktioniert nicht
12.06.2012 22:59:19 coena
NotSolved

Ansicht des Beitrags:
Von:
coena
Datum:
12.06.2012 22:59:19
Views:
2362
Rating: Antwort:
  Ja
Thema:
Makro für Tabellenkomination funktioniert nicht

Hallo, 
ich möchte aus einer Tabelle mit Zellenprogrammierung durch ein makro eine neue Gesamttabelle erstellen um die grafisch auswerten zu können. 
In meiner ursprünglichen Tabelle gibt es eine zeile über einen bestimmten Zeitraum, die immer einen Monat weiterläuft. Jedem dieser Monate ist ein bestimmter Wert zugeordnet. 
Daraus möchte ich eine Tabelle über den gesamten Zeitraum vom kleinsten Datum bis zum größten erstellen, in dem die Werte den Daten zugeordnet werden und bei den Daten zu den es bei einer Zeitraum keinen Wert gibt, da das Datum vor oder nach dem Zeitraum liegt, soll diesem eine Datum dann eine Null zugeordnet werden. Dazu habe ich folgenden Code geschrieben, der mir Leider nur die Überschriften der wertereihen und 4-Zellen mit Daten ausgibt. 
Hab ich einen Denkfehler in der Programmierung? 

Sub Tabelle() 
    Dim i, j, k, z As Integer 
    Dim iZeile, iSpalte As Integer 
    Dim iIst, igesamt, iDatDiff As Integer 
    Dim klDatum, grDatum As Date 
    
    klDatum = Worksheets(sTbl3).Cells(25, 4).Value 
    grDatum = Worksheets(sTbl3).Cells(25, 4).Value 

    With Worksheets(sTbl4) 
        ' Neuer Diagrammbereich 
        For i = 25 To Worksheets(sTbl3).Range("BC25") 
            .Range("C1").Select 
            iZeile = .Range("C2") 
            iSpalte = 3 

          For j = 25 To Worksheets(sTbl3).Range("B105").End(xlUp).Row + 2 
                 Select Case i 
                    Case 25: 
                        .Cells(iZeile, iSpalte).NumberFormat = "MMM YY" 
                        .Cells(iZeile, iSpalte).Value = Worksheets(sTbl3).Cells(j, i).Value 
                        
                        ' Das Anfangs- sowie Enddatum  ermitteln 
                        If Worksheets(sTbl3).Cells(j, i).Value < klDatum Then klDatum = Worksheets(sTbl3).Cells(j, i).Value 
                        If Worksheets(sTbl3).Cells(j, i).Value > grDatum Then grDatum = Worksheets(sTbl3).Cells(j, i).Value 

                    Case Else: 
                        .Cells(iZeile, iSpalte).NumberFormat = "MMM YY" 
                        .Cells(iZeile, iSpalte).Value = Worksheets(sTbl3).Cells(j, i).Value - 1 
                        If Worksheets(sTbl3).Cells(j, i).Value < klDatum Then klDatum = Worksheets(sTbl3).Cells(j, i).Value 
                        If Worksheets(sTbl3).Cells(j, i).Value > grDatum Then grDatum = Worksheets(sTbl3).Cells(j, i).Value 
                End Select 

              ' Anfangsdatum nächster Monat auf Zeitachse 
              Select Case Month(klDatum) 
                  Case 1, 3, 5, 7, 8, 10, 12: 
                      iDatDiff = 31 
                  Case 2: 
                      iDatDiff = 28 
                      If Year(klDatum) Mod 2 = 0 Then iDatDiff = 29 
                  Case Else: 
                      iDatDiff = 30 
              End Select 
              klDatum = klDatum + iDatDiff 
              If klDatum > grDatum Then 
                  i = i + 1 
                  Exit For 
              End If 
            iSpalte = iSpalte + 1 
          Next j 
        Next i 

        z = i 
        k = .Range("B105").End(xlUp).Row 
        iZeile = .Range("B100").End(xlUp).Row + 1 

        For i = 25 To Worksheets(sTbl3).Range("B105").End(xlUp).Row Step 2 
           .Cells(iZeile, 2).Value = Worksheets(sTbl3).Cells(i, 2).Value 
           For j = Worksheets(sTbl3).Range("D26") To Worksheets(sTbl3).Range("BC26") 
                For iSpalte = 2 To .Range("B2").End(xlToRight).Column 
                    If Month(.Cells(iZeile, iSpalte).Value) = Month(.Cells(i, j).Value) Then 
                        If Year(.Cells(iZeile, iSpalte).Value) = Year(.Cells(i, j).Value) Then 
                            .Cells(iZeile, iSpalte).Value = Worksheets(sTbl3).Cells(j, i).Value 
                            Exit For 
                        End If 
                    End If 
                Next iSpalte 
                If j = 48 Then j = 45 
                If j = 28 Then 
                    If .Cells(iZeile, j).Value = "" Then .Cells(iZeile, j).Value = 0 
                    j = j + 1 
                End If 
                If .Cells(iZeile, j).Value = "" Then .Cells(iZeile, j).Value = .Cells(iZeile, j - 1).Value 
            Next j 
            For j = iSpalte + 1 To z - 1 
                .Cells(iZeile, j).Value = 0 
            Next j 
            iZeile = iZeile + 1 
        Next i 
        .Cells(iZeile - 1, 2).Value = "Differenz" 
        For j = 3 To z 
            iIst = 0 
            For i = (k + 3) To (iZeile - 1) 
                iIst = iIst + .Cells(i, j).Value 
            Next i 
            .Cells(iZeile, j).Value = Worksheets(sTbl3).Range("C106").Value - iIst 
            If .Cells(iZeile, j).Value < 0 Then .Cells(iZeile, j).Value = 0 
        Next j 
        iZeile = iZeile + 1 
        .Cells(iZeile - 1, 2).Value = "Gesamtfälle" 
        For i = 2 To z 
            igesamt = Worksheets(sTbl3).Range("C105").Value 
        Next i 

        End With 

    Exit Sub 

Gruß coena

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Makro für Tabellenkomination funktioniert nicht
12.06.2012 22:59:19 coena
NotSolved