Doppelschleife mit und ohne Sprung

Hallo zusammen,
mein Problem ist nicht so leicht zu beschreiben und beginnt in Spalte CF der Beispieldatei
https://www.herber.de/bbs/user/22389.xls
Zwei 6-stellige Ziffer (Text) werden nach 3 Stellen links und 3 Stellen rechts, getrennt aufsummiert (danke Holger und Andi) und sollen in einer Zeile aufgereiht werden.
Spalte CF
003001
001012
soll in Zeile 15
Spalte CF___Spalte CG
__4__________13
aufsummiert werden.
Wie gesagt. Das Ganze mit 2 Schleifen. Textziffern stehen direkt nebeneinander und die rechts/links getrennten Summen müssen ja jeweils ein Spalte überspringen.
Ich hoffe anhand der Datei (inkl. bescheidenem Lösungsansatz) erkennt ihr das Problem besser und jemand weiß Rat.
Dankeschön schonmal
Harald

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub tt() For i = 4 To 121 If i <= 83 Then Cells(14, i + x) = Cells(1, i) Cells(15, i) = WorksheetFunction.Sum(Cells(2, i), Cells(3, i)) Cells(16, i) = WorksheetFunction.Sum(Cells(4, i), Cells(5, i)) Cells(17, i) = WorksheetFunction.Sum(Cells(6, i), Cells(7, i)) Else Cells(14, i + x) = Cells(1, i) Cells(15, i + x) = Val(Left(Cells(2, i), 3)) + Val(Left(Cells(3, i), 3)) Cells(16, i + x) = Val(Left(Cells(4, i), 3)) + Val(Left(Cells(5, i), 3)) Cells(17, i + x) = Val(Left(Cells(6, i), 3)) + Val(Left(Cells(7, i), 3)) Cells(15, i + x + 1) = Val(Right(Cells(2, i), 3)) + Val(Right(Cells(3, i), 3)) Cells(16, i + x + 1) = Val(Right(Cells(4, i), 3)) + Val(Right(Cells(5, i), 3)) Cells(17, i + x + 1) = Val(Right(Cells(6, i), 3)) + Val(Right(Cells(7, i), 3)) x = x + 1 End If Next i End Sub Gruß Reinhard Tabellenblattname: Sheet 1 CE CF CG CH CI CJ CK CL CM CN CO CP CQ CR CS 1 JOINT80 COMP01 COMP02 COMP03 COMP04 COMP05 COMP06 COMP07 COMP08 COMP09 COMP10 COMP11 COMP12 COMP13 COMP14 2 0 000000 000000 000000 000000 000000 000000 013053 000000 000000 000002 008014 008000 000000 000000 3 0 000000 000000 000000 000000 000000 000000 001001 000000 000000 000000 000000 000000 000000 000000 4 0 000000 000000 000000 000000 000000 000000 004048 000000 000000 000002 002002 004000 000000 000000 5 0 000000 000000 000000 000000 000000 000000 000001 000000 000000 000000 001000 001000 000000 000000 6 0 000000 000000 000000 000000 000000 000000 002039 000000 000000 000004 007006 007000 000000 000000 7 0 000000 000000 000000 000000 000000 000000 001001 000000 000000 000000 000000 000000 000000 000000 8 013053 9 001001 10 004048 11 000001 12 002039 13 falsch: 001001 14 JOINT80 COMP01 COMP02 COMP03 COMP04 COMP05 COMP06 COMP07 15 0 0 0 0 0 0 0 0 0 0 0 0 0 14 54 16 0 0 0 0 0 0 0 0 0 0 0 0 0 4 49 17 0 0 0 0 0 0 0 0 0 0 0 0 0 3 40

Sub test() Dim e As Integer, i As Integer, n As Integer 'Summe Joints funzt For i = 4 To 83 Cells(15, i).Value = WorksheetFunction.Sum(Cells(2, i), Cells(3, i)) Cells(16, i).Value = WorksheetFunction.Sum(Cells(4, i), Cells(5, i)) Cells(17, i).Value = WorksheetFunction.Sum(Cells(6, i), Cells(7, i)) Next i 'Summen links der beidseitigen Kontrollen e = 82 For i = 84 To 121 e = e + 2 Cells(14, e).Value = Cells(1, i).Value Cells(15, e).Value = Val(Left(Cells(2, i), 3)) + Val(Left(Cells(3, i), 3)) Cells(16, e).Value = Val(Left(Cells(4, i), 3)) + Val(Left(Cells(5, i), 3)) Cells(17, e).Value = Val(Left(Cells(6, i), 3)) + Val(Left(Cells(7, i), 3)) Next i 'Summe rechts der beidseitigen Kontrollen n = 83 For i = 84 To 121 n = n + 2 Cells(15, n).Value = Val(Right(Cells(2, i), 3)) + Val(Right(Cells(3, i), 3)) Cells(16, n).Value = Val(Right(Cells(4, i), 3)) + Val(Right(Cells(5, i), 3)) Cells(17, n).Value = Val(Right(Cells(6, i), 3)) + Val(Right(Cells(7, i), 3)) Next i End Sub

Sub test() 'Summe Joints funzt For i = 4 To 83 Cells(15, i) = WorksheetFunction.Sum(Cells(2, i), Cells(3, i)) Cells(16, i) = WorksheetFunction.Sum(Cells(4, i), Cells(5, i)) Cells(17, i) = WorksheetFunction.Sum(Cells(6, i), Cells(7, i)) Next i 'Summe links der beidseitigen Kontrollen funzt net i = 84 For e = 84 To 160 Step 2 Cells(14, e) = Cells(1, i) Cells(15, e) = Val(Left(Cells(2, i), 3)) + Val(Left(Cells(3, i), 3)) Cells(16, e) = Val(Left(Cells(4, i), 3)) + Val(Left(Cells(5, i), 3)) Cells(17, e) = Val(Left(Cells(6, i), 3)) + Val(Left(Cells(7, i), 3)) Cells(15, e + 1) = Val(Right(Cells(2, i), 3)) + Val(Right(Cells(3, i), 3)) Cells(16, e + 1) = Val(Right(Cells(4, i), 3)) + Val(Right(Cells(5, i), 3)) Cells(17, e + 1) = Val(Right(Cells(6, i), 3)) + Val(Right(Cells(7, i), 3)) i = i + 1 Next e End Sub

Hallo Harald,
der ist am schnellsten *g
Gruß
Reinhard


Sub tt()
ActiveSheet.UsedRange.Clear
Dim sum(4)
Application.ScreenUpdating = False
anz = 10 ' Anzahl Durchgänge max ca 125
For n = 1 To 2 * anz Step 2
Call blind
Cells(1, n) = Timer
Call ich
Cells(2, n) = Timer
Call ich2
Cells(3, n) = Timer
Call werner
Cells(4, n) = Timer
Call uwe
Cells(5, n) = Timer
Next n
[A6] = Cells(4, n - 2) - Cells(1, 1) 'Gesamtzeit
For n = 1 To 2 * anz Step 2
Cells(1, n + 1) = Cells(2, n) - Cells(1, n)
sum(1) = sum(1) + Cells(1, n + 1)
Cells(2, n + 1) = Cells(3, n) - Cells(2, n)
sum(2) = sum(2) + Cells(2, n + 1)
Cells(3, n + 1) = Cells(4, n) - Cells(3, n)
sum(3) = sum(3) + Cells(3, n + 1)
Cells(4, n + 1) = Cells(5, n) - Cells(4, n)
sum(4) = sum(4) + Cells(4, n + 1)
Next n
[A10] = sum(1) / anz
[A11] = sum(2) / anz
[A12] = sum(3) / anz
[A13] = sum(4) / anz
Application.ScreenUpdating = True
End Sub


Sub blind()
End Sub


Sub ich()
For i = 4 To 121
Select Case i
Case Is <= 83
Cells(14, i + x) = Cells(1, i)
Cells(15, i) = WorksheetFunction.sum(Cells(2, i), Cells(3, i))
Cells(16, i) = WorksheetFunction.sum(Cells(4, i), Cells(5, i))
Cells(17, i) = WorksheetFunction.sum(Cells(6, i), Cells(7, i))
Case Else
Cells(14, i + x) = Cells(1, i)
Cells(15, i + x) = Val(Left(Cells(2, i), 3)) + Val(Left(Cells(3, i), 3))
Cells(16, i + x) = Val(Left(Cells(4, i), 3)) + Val(Left(Cells(5, i), 3))
Cells(17, i + x) = Val(Left(Cells(6, i), 3)) + Val(Left(Cells(7, i), 3))
Cells(15, i + x + 1) = Val(Right(Cells(2, i), 3)) + Val(Right(Cells(3, i), 3))
Cells(16, i + x + 1) = Val(Right(Cells(4, i), 3)) + Val(Right(Cells(5, i), 3))
Cells(17, i + x + 1) = Val(Right(Cells(6, i), 3)) + Val(Right(Cells(7, i), 3))
x = x + 1
End Select
Next i
End Sub


Sub ich2()
For i = 4 To 121
If i <= 83 Then
Cells(14, i + x) = Cells(1, i)
Cells(15, i) = WorksheetFunction.sum(Cells(2, i), Cells(3, i))
Cells(16, i) = WorksheetFunction.sum(Cells(4, i), Cells(5, i))
Cells(17, i) = WorksheetFunction.sum(Cells(6, i), Cells(7, i))
Else
Cells(14, i + x) = Cells(1, i)
Cells(15, i + x) = Val(Left(Cells(2, i), 3)) + Val(Left(Cells(3, i), 3))
Cells(16, i + x) = Val(Left(Cells(4, i), 3)) + Val(Left(Cells(5, i), 3))
Cells(17, i + x) = Val(Left(Cells(6, i), 3)) + Val(Left(Cells(7, i), 3))
Cells(15, i + x + 1) = Val(Right(Cells(2, i), 3)) + Val(Right(Cells(3, i), 3))
Cells(16, i + x + 1) = Val(Right(Cells(4, i), 3)) + Val(Right(Cells(5, i), 3))
Cells(17, i + x + 1) = Val(Right(Cells(6, i), 3)) + Val(Right(Cells(7, i), 3))
x = x + 1
End If
Next i
End Sub


Sub werner()
Dim e As Integer, i As Integer, n As Integer
'Summe Joints funzt
For i = 4 To 83
Cells(15, i).Value = WorksheetFunction.sum(Cells(2, i), Cells(3, i))
Cells(16, i).Value = WorksheetFunction.sum(Cells(4, i), Cells(5, i))
Cells(17, i).Value = WorksheetFunction.sum(Cells(6, i), Cells(7, i))
Next i
'Summen links der beidseitigen Kontrollen
e = 82
For i = 84 To 121
e = e + 2
Cells(14, e).Value = Cells(1, i).Value
Cells(15, e).Value = Val(Left(Cells(2, i), 3)) + Val(Left(Cells(3, i), 3))
Cells(16, e).Value = Val(Left(Cells(4, i), 3)) + Val(Left(Cells(5, i), 3))
Cells(17, e).Value = Val(Left(Cells(6, i), 3)) + Val(Left(Cells(7, i), 3))
Next i
'Summe rechts der beidseitigen Kontrollen
n = 83
For i = 84 To 121
n = n + 2
Cells(15, n).Value = Val(Right(Cells(2, i), 3)) + Val(Right(Cells(3, i), 3))
Cells(16, n).Value = Val(Right(Cells(4, i), 3)) + Val(Right(Cells(5, i), 3))
Cells(17, n).Value = Val(Right(Cells(6, i), 3)) + Val(Right(Cells(7, i), 3))
Next i
End Sub


Sub uwe()
'Summe Joints funzt
For i = 4 To 83
Cells(15, i) = WorksheetFunction.sum(Cells(2, i), Cells(3, i))
Cells(16, i) = WorksheetFunction.sum(Cells(4, i), Cells(5, i))
Cells(17, i) = WorksheetFunction.sum(Cells(6, i), Cells(7, i))
Next i
'Summe links der beidseitigen Kontrollen funzt net
i = 84
For e = 84 To 160 Step 2
Cells(14, e) = Cells(1, i)
Cells(15, e) = Val(Left(Cells(2, i), 3)) + Val(Left(Cells(3, i), 3))
Cells(16, e) = Val(Left(Cells(4, i), 3)) + Val(Left(Cells(5, i), 3))
Cells(17, e) = Val(Left(Cells(6, i), 3)) + Val(Left(Cells(7, i), 3))
Cells(15, e + 1) = Val(Right(Cells(2, i), 3)) + Val(Right(Cells(3, i), 3))
Cells(16, e + 1) = Val(Right(Cells(4, i), 3)) + Val(Right(Cells(5, i), 3))
Cells(17, e + 1) = Val(Right(Cells(6, i), 3)) + Val(Right(Cells(7, i), 3))
i = i + 1
Next e
End Sub

Beliebteste Forumthreads (12 Monate)

Doppelschleife mit und ohne Sprung

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread