Thema Datum  Von Nutzer Rating
Antwort
Rot Code soll nur jede zweite Spalte ansprechen und Berechnung
 13.12.2017 07:52:02 Ben
NotSolved
13.12.2017 09:01:45 Gast16235
NotSolved

Ansicht des Beitrags:
Von:
Ben		 Datum:
13.12.2017 07:52:02		 Views:
1036		 Rating:
     
Antwort:
  Ja
Thema:
Code soll nur jede zweite Spalte ansprechen und Berechnung

Hallo zusammen,

 

Ich berechne per untenstehenden Code in jeweils zwei Tabellenblättern über mehrere Zeilen und Spalten.

Ich ziehe einen Wert zeilenweise ab (Januar bis Dezember).

Nun sollen jeweils neue Spalten eingetragen werden, welche zwischen den bisherigen Spalten kommen, d.h. Januar, neue Spalte  rechts (Abzug Januar), Februar, neue Spalte rechts (Abzug Feb.) usw....

In den neuen Spalten soll am Ende die Differenz zwischen Ursprungswert und Wert nach Abzug stehen. Der  Wert soll zusätzlich mit jedem Abzug addiert werden.

Beispiel: Januar: 50 Februar: 40 März: 30

Abzug laut Code: 60

Neuer Wert Jan 0 Feb. 30

Abzug Jan: 50  Abzug Feb. 10

Neuer Abzug laut Code: 20

Neuer Wert Jan. 0 Feb. 10

Abzug: Jan. 50 Abzug Februar: 30

Dafür muss aber im untenstehendem Code nur noch jede zweite Spalte angesprochen werden.

Case hat nicht funktioniert.

Jemand eine Idee?

Ben

 

?
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
Sub Überstundenabbauen_Funktion(sg As String)
Dim LeZe As Long
Dim n As Single
Dim i As Single
Dim Dneu As Single
Dim jahr As Integer
Dim ws1, ws2 As String
 
'jahr = Year(Date)
 
 
'ws2 = sg & jahr
'ws1 = sg & (jahr - 1)
ws1 = sg & "2017"
ws2 = sg & "2018"
 
 
LeZe = ThisWorkbook.Worksheets(ws2).Cells(Rows.Count, 4).End(xlUp).Row
 
For n = 4 To LeZe 'Zeilen
    Dneu = Worksheets(ws2).Cells(n, 4)
        For i = 5 To 18 ' Spalten E bis R
            If Dneu <= Worksheets(ws1).Cells(n, i) Then
               Worksheets(ws1).Cells(n, i) = Worksheets(ws1).Cells(n, i) - Dneu
               Dneu = 0
            Else
               Dneu = Dneu - Worksheets(ws1).Cells(n, i)
               Worksheets(ws1).Cells(n, i) = 0
            End If
        Next i
       
       
       
      If Dneu = 0 Then
        Worksheets(ws2).Cells(n, 4) = 0
        GoTo weiter
      End If
       
      For i = 5 To 18 ' Spalten E bis R
            If Dneu <= Worksheets(ws2).Cells(n, i) Then
               Worksheets(ws2).Cells(n, i) = Worksheets(ws2).Cells(n, i) - Dneu
               Dneu = 0
            Else
               Dneu = Dneu - Worksheets(ws2).Cells(n, i)
               Worksheets(ws2).Cells(n, i) = 0
            End If
        Next i
        Worksheets(ws2).Cells(n, 4) = 0
weiter:
Next n
 
 
 
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:
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 Code soll nur jede zweite Spalte ansprechen und Berechnung
 13.12.2017 07:52:02 Ben
NotSolved
13.12.2017 09:01:45 Gast16235
NotSolved