Thema Datum  Von Nutzer Rating
Antwort
17.04.2016 18:12:20 Julian
NotSolved
17.04.2016 18:58:59 Gast70117
NotSolved
17.04.2016 19:36:42 Julian
NotSolved
17.04.2016 19:39:32 Gast68571
NotSolved
Rot Grüße aus dem Cyberspace!
18.04.2016 09:38:59 Gast70117
NotSolved

Ansicht des Beitrags:
Von:
Gast70117
Datum:
18.04.2016 09:38:59
Views:
1067
Rating: Antwort:
  Ja
Thema:
Grüße aus dem Cyberspace!
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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
Option Explicit
 
Sub Einfach()
'und geschmacklos, die Zelle mit dem letzten Werteeintrag ist markiert - aktuell selektiert
Dim rngMittelZelle As Range
Dim rngMonatswertZelle As Range
Dim rngMittelBereich As Range
 
With ActiveSheet
   Set rngMonatswertZelle = Selection
   'der User weis, was er macht
   Select Case rngMonatswertZelle.Column
      Case Is >= 4
         Set rngMittelBereich = _
         Range(rngMonatswertZelle.Offset(, -2), rngMonatswertZelle)
      Case 3
         Set rngMittelBereich = _
         Range(rngMonatswertZelle.Offset(, -1), rngMonatswertZelle)
      Case 2
         Set rngMittelBereich = rngMonatswertZelle
   End Select
   Set rngMittelZelle = .Range("N3")
   'schreiben
   rngMittelZelle.ClearContents
   On Error Resume Next
   rngMittelZelle.Value = WorksheetFunction.Average(rngMittelBereich)
   On Error GoTo 0
End With
End Sub
 
 
 
Sub Mittelwert()
'1) die Spalte mit dem Mittelwert ist die äußerst rechte der Titelzeile 1
'   die Zelle dazu in der 3. Zeile
'2) Monate haben num. Stellenwert in Zeile 2
'3) keine Fehlerbehandlung, wenn die Vorgaben nicht stimmen!
 
Dim rngMittelZelle As Range
Dim rngMonatswertZelle As Range
Dim rngMittelBereich As Range
'Hinweisflag
Dim Flag As Boolean
 
   'Mittelwertzelle finden
   With ActiveSheet
      'Zeile 1 von rechts nach links
      Set rngMittelZelle = .Cells(1, .Columns.Count).End(xlToLeft)
      '2 Zeilen darunter
      Set rngMittelZelle = rngMittelZelle.Offset(2)
      'Zahlenwert nach akt. Monat und Eintrag prüfen
      'in der 2. Zeile
      With .Rows(2)
         Set rngMonatswertZelle = .Find(What:=Month(Date), After:=.Cells(1), _
         LookIn:=xlValues, LookAt:=xlWhole)
      End With
      'der Wert eine Zeile darunter
      Set rngMonatswertZelle = rngMonatswertZelle.Offset(1)
      'aktuelles Monat belegt?
      'Werte rechts davon (Zukunft unberücksichtigt)
      If rngMonatswertZelle.Value <> 0 Then
         'nach Spalte wo
         Select Case rngMonatswertZelle.Column
            Case Is >= 4
               Set rngMittelBereich = _
               Range(rngMonatswertZelle.Offset(, -2), rngMonatswertZelle)
            Case 3
               Set rngMittelBereich = _
               Range(rngMonatswertZelle.Offset(, -1), rngMonatswertZelle)
               'Hinweis
               Flag = True
            Case 2
               Set rngMittelBereich = rngMonatswertZelle
               'Hinweis
               Flag = True
         End Select
      Else
         Select Case MsgBox("kein aktueller Wert für Monat " & Month(Date) _
         & Chr(10) & "dennoch rechnen?", _
         vbYesNo + vbExclamation, "Achtung")
            Case vbYes
               'weiter so
               'nach Spalte wo
               Select Case rngMonatswertZelle.Column
                  Case Is >= 4
                     Set rngMittelBereich = _
                     Range(rngMonatswertZelle.Offset(, -2), rngMonatswertZelle)
                  Case 3
                     Set rngMittelBereich = _
                     Range(rngMonatswertZelle.Offset(, -1), rngMonatswertZelle)
                     'Hinweis
                     Flag = True
                  Case 2
                     Set rngMittelBereich = rngMonatswertZelle
                     'Hinweis
                     Flag = True
               End Select
            Case vbNo
               'neu bestimmen
               Do
                  Set rngMonatswertZelle = rngMonatswertZelle.Offset(, -1)
                  If IsNumeric(rngMonatswertZelle.Value) Then
                     Flag = True
                     Exit Do
                  Else
                     Exit Sub
                  End If
               Loop
               'nach Spalte wo
               Select Case rngMonatswertZelle.Column
                  Case Is >= 4
                     Set rngMittelBereich = _
                     Range(rngMonatswertZelle.Offset(, -2), rngMonatswertZelle)
                  Case 3
                     Set rngMittelBereich = _
                     Range(rngMonatswertZelle.Offset(, -1), rngMonatswertZelle)
                     'Hinweis
                     Flag = True
                  Case 2
                     Set rngMittelBereich = rngMonatswertZelle
                     'Hinweis
                     Flag = True
               End Select
         End Select
      End If
      'schreiben
      rngMittelZelle.ClearContents
      On Error Resume Next
      rngMittelZelle.Value = WorksheetFunction.Average(rngMittelBereich)
      On Error GoTo 0
   End With
    
   'Hinweis
   If Flag = True Then _
   Call MsgBox("kein Mittelwert aus 3 Monaten! ", _
         vbOKOnly + vbExclamation, "Achtung")
    
End Sub

 


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
17.04.2016 18:12:20 Julian
NotSolved
17.04.2016 18:58:59 Gast70117
NotSolved
17.04.2016 19:36:42 Julian
NotSolved
17.04.2016 19:39:32 Gast68571
NotSolved
Rot Grüße aus dem Cyberspace!
18.04.2016 09:38:59 Gast70117
NotSolved