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:
2489		 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? 

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
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
 
<span style="color: rgb(0, 0, 0); font-family: Verdana, Arial, Helvetica, sans-serif; line-height: 18px; background-color: rgb(239, 239, 239); ">Gruß coena</span>

 

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:
WYSIWYG-Editor, ctl00_Content_editor1



  • 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