Doppelschleife mit und ohne Sprung

Forumthread: Doppelschleife mit und ohne Sprung

10.05.2005 12:46:17

Harald

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

AW: Doppelschleife mit und ohne Sprung

10.05.2005 13:26:51

Reinhard

Hallo Harald,
geht mit einer Schleife:

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

AW: Doppelschleife mit und ohne Sprung

10.05.2005 13:58:23

WernerB.

Hallo Harald,
wie gefällt Dir das?


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

Viel Erfolg wünscht
WernerB.
P.S.: Dieses Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter !

AW: Doppelschleife mit und ohne Sprung

10.05.2005 14:18:04

UweD

Hallo
so:


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

Gruß UweD

Läuft ebenfalls bestens

10.05.2005 14:29:21

Harald

Hallo Uwe,
vielen Dank.
Boah...jetzt schwitzt der Salomon schon eher ;-))
Deine Lösung hab ich mir jedenfalss schon in mein Archiv kopiert. Man weiß ja nie.
Danke und nette Grüße
Harald

Genial !! Salomon hilf mir

10.05.2005 14:20:28

Harald

Reinhard, Werner
vielen, vielen Dank. Beide Codes laufen superschnell und fehlerfrei durch.
Bin begeistert. GottseiDank haben wir 2 getrennte Produktionslinien mit leicht unterschiedlichen Quelldaten. Somit hat Salomon leichtes Spiel.
Es werden beide Codes in der Praxis laufen.
Nochma Hut ab und Dankeschön !
Harald

Ich würde den Code von Uwe nehmen

10.05.2005 15:37:42

Uwe

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

AW: Ich würde den Code von Uwe nehmen

11.05.2005 09:00:01

Uwe

Hi Reinhard,
in der Tat, Uwe's Code ist schneller.
Grob über den Daumen, bringt mir der Code nach etwa 300 Durchläufen eine zusätzliche Zigarettenpause ;-)))
Meine bisherige Lösung (Teilergebnis per nachgebesserter Rekorderaufzeichnung) bleibt deutlich hinter alle neuen Lösungen zurück und war obendrein zu unflexibel.
Gruß
Harald

AW: Ich würde den Code von Uwe nehmen

11.05.2005 15:06:32

Uwe

Hallo Harald,
in C, 20 Jahre her, alles vergessen*g gabs mal eine Tabelle aller Befehle mit ihren Zeiten.
Also jetzt mal fingiert:
if + singleausdruck 5xs (x weil durch rumspielen am tastaturtreiber sind mein my und die tilde wech :-)
if + double 7 xs
if + string 12 xs
if + variant 18 xs
war sehr interessant. Wünschte ich mir für die VBA Befehle auch, zum optimieren.
Gruß
Reinhard

Beliebteste Forumthreads (12 Monate)

Doppelschleife mit und ohne Sprung

Forumthread: Doppelschleife mit und ohne Sprung

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread