PDA

Vollständige Version anzeigen : Prozedur zu lang


brain
13.09.2011, 17:18
Hallo zusammen,

ich als VBA Anfänger bräuchte einmal hilfe folgenden Code zu kürzen, da dieser mehrfach zum Einsatz kommt und die Prozedur zu lang wird.

ActiveSheet.Cells(z.Row, 31) = ActiveSheet.Cells(z.Row, 31).Value + ActiveSheet.Cells(z.Row, 2).Value
ActiveSheet.Cells(z.Row, 32) = ActiveSheet.Cells(z.Row, 32).Value + ActiveSheet.Cells(z.Row, 3).Value
ActiveSheet.Cells(z.Row, 33) = ActiveSheet.Cells(z.Row, 33).Value + ActiveSheet.Cells(z.Row, 4).Value
ActiveSheet.Cells(z.Row, 34) = ActiveSheet.Cells(z.Row, 34).Value + ActiveSheet.Cells(z.Row, 5).Value
ActiveSheet.Cells(z.Row, 35) = ActiveSheet.Cells(z.Row, 35).Value + ActiveSheet.Cells(z.Row, 6).Value
ActiveSheet.Cells(z.Row, 36) = ActiveSheet.Cells(z.Row, 36).Value + ActiveSheet.Cells(z.Row, 7).Value
ActiveSheet.Cells(z.Row, 37) = ActiveSheet.Cells(z.Row, 37).Value + ActiveSheet.Cells(z.Row, 8).Value
ActiveSheet.Cells(z.Row, 38) = ActiveSheet.Cells(z.Row, 38).Value + ActiveSheet.Cells(z.Row, 9).Value
ActiveSheet.Cells(z.Row, 39) = ActiveSheet.Cells(z.Row, 39).Value + ActiveSheet.Cells(z.Row, 10).Value
ActiveSheet.Cells(z.Row, 40) = ActiveSheet.Cells(z.Row, 40).Value + ActiveSheet.Cells(z.Row, 11).Value
ActiveSheet.Cells(z.Row, 41) = ActiveSheet.Cells(z.Row, 41).Value + ActiveSheet.Cells(z.Row, 12).Value
ActiveSheet.Cells(z.Row, 42) = ActiveSheet.Cells(z.Row, 42).Value + ActiveSheet.Cells(z.Row, 13).Value
ActiveSheet.Cells(z.Row, 43) = ActiveSheet.Cells(z.Row, 43).Value + ActiveSheet.Cells(z.Row, 14).Value
ActiveSheet.Cells(z.Row, 44) = ActiveSheet.Cells(z.Row, 44).Value + ActiveSheet.Cells(z.Row, 15).Value
ActiveSheet.Cells(z.Row, 45) = ActiveSheet.Cells(z.Row, 45).Value + ActiveSheet.Cells(z.Row, 16).Value
ActiveSheet.Cells(z.Row, 46) = ActiveSheet.Cells(z.Row, 46).Value + ActiveSheet.Cells(z.Row, 17).Value
ActiveSheet.Cells(z.Row, 47) = ActiveSheet.Cells(z.Row, 47).Value + ActiveSheet.Cells(z.Row, 18).Value
ActiveSheet.Cells(z.Row, 48) = ActiveSheet.Cells(z.Row, 48).Value + ActiveSheet.Cells(z.Row, 19).Value
ActiveSheet.Cells(z.Row, 49) = ActiveSheet.Cells(z.Row, 49).Value + ActiveSheet.Cells(z.Row, 20).Value
ActiveSheet.Cells(z.Row, 50) = ActiveSheet.Cells(z.Row, 50).Value + ActiveSheet.Cells(z.Row, 21).Value
ActiveSheet.Cells(z.Row, 51) = ActiveSheet.Cells(z.Row, 51).Value + ActiveSheet.Cells(z.Row, 22).Value
ActiveSheet.Cells(z.Row, 52) = ActiveSheet.Cells(z.Row, 52).Value + ActiveSheet.Cells(z.Row, 23).Value
ActiveSheet.Cells(z.Row, 53) = ActiveSheet.Cells(z.Row, 53).Value + ActiveSheet.Cells(z.Row, 24).Value
ActiveSheet.Cells(z.Row, 54) = ActiveSheet.Cells(z.Row, 54).Value + ActiveSheet.Cells(z.Row, 25).Value
ActiveSheet.Cells(z.Row, 55) = ActiveSheet.Cells(z.Row, 55).Value + ActiveSheet.Cells(z.Row, 26).Value
ActiveSheet.Cells(z.Row, 56) = ActiveSheet.Cells(z.Row, 56).Value + ActiveSheet.Cells(z.Row, 27).Value
ActiveSheet.Cells(z.Row, 57) = ActiveSheet.Cells(z.Row, 57).Value + ActiveSheet.Cells(z.Row, 28).Value
ActiveSheet.Cells(z.Row, 58) = ActiveSheet.Cells(z.Row, 58).Value + ActiveSheet.Cells(z.Row, 29).Value
ActiveSheet.Cells(z.Row, 59) = ActiveSheet.Cells(z.Row, 59).Value + ActiveSheet.Cells(z.Row, 30).Value

Hajo_Zi
13.09.2011, 17:29
mache eine For Schleife.

<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm" onclick="window.open(this.href);return false"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>

Brain
13.09.2011, 17:33
Also hier nochmal etwas vollständiger der Code.
Wie, wo kann bzw. muss ich die For schleife einbauen?

With Sheets("Januar").Activate
Set z = ActiveSheet.Range("A:A").Find(Date)
If z Is Nothing Then
Else
Zahlenmeldung.Edit z.Row
ActiveSheet.Cells(z.Row, 31) = ActiveSheet.Cells(z.Row, 31).Value + ActiveSheet.Cells(z.Row, 2).Value
ActiveSheet.Cells(z.Row, 32) = ActiveSheet.Cells(z.Row, 32).Value + ActiveSheet.Cells(z.Row, 3).Value
ActiveSheet.Cells(z.Row, 33) = ActiveSheet.Cells(z.Row, 33).Value + ActiveSheet.Cells(z.Row, 4).Value
ActiveSheet.Cells(z.Row, 34) = ActiveSheet.Cells(z.Row, 34).Value + ActiveSheet.Cells(z.Row, 5).Value
ActiveSheet.Cells(z.Row, 35) = ActiveSheet.Cells(z.Row, 35).Value + ActiveSheet.Cells(z.Row, 6).Value
ActiveSheet.Cells(z.Row, 36) = ActiveSheet.Cells(z.Row, 36).Value + ActiveSheet.Cells(z.Row, 7).Value
ActiveSheet.Cells(z.Row, 37) = ActiveSheet.Cells(z.Row, 37).Value + ActiveSheet.Cells(z.Row, 8).Value
ActiveSheet.Cells(z.Row, 38) = ActiveSheet.Cells(z.Row, 38).Value + ActiveSheet.Cells(z.Row, 9).Value
ActiveSheet.Cells(z.Row, 39) = ActiveSheet.Cells(z.Row, 39).Value + ActiveSheet.Cells(z.Row, 10).Value
ActiveSheet.Cells(z.Row, 40) = ActiveSheet.Cells(z.Row, 40).Value + ActiveSheet.Cells(z.Row, 11).Value
ActiveSheet.Cells(z.Row, 41) = ActiveSheet.Cells(z.Row, 41).Value + ActiveSheet.Cells(z.Row, 12).Value
ActiveSheet.Cells(z.Row, 42) = ActiveSheet.Cells(z.Row, 42).Value + ActiveSheet.Cells(z.Row, 13).Value
ActiveSheet.Cells(z.Row, 43) = ActiveSheet.Cells(z.Row, 43).Value + ActiveSheet.Cells(z.Row, 14).Value
ActiveSheet.Cells(z.Row, 44) = ActiveSheet.Cells(z.Row, 44).Value + ActiveSheet.Cells(z.Row, 15).Value
ActiveSheet.Cells(z.Row, 45) = ActiveSheet.Cells(z.Row, 45).Value + ActiveSheet.Cells(z.Row, 16).Value
ActiveSheet.Cells(z.Row, 46) = ActiveSheet.Cells(z.Row, 46).Value + ActiveSheet.Cells(z.Row, 17).Value
ActiveSheet.Cells(z.Row, 47) = ActiveSheet.Cells(z.Row, 47).Value + ActiveSheet.Cells(z.Row, 18).Value
ActiveSheet.Cells(z.Row, 48) = ActiveSheet.Cells(z.Row, 48).Value + ActiveSheet.Cells(z.Row, 19).Value
ActiveSheet.Cells(z.Row, 49) = ActiveSheet.Cells(z.Row, 49).Value + ActiveSheet.Cells(z.Row, 20).Value
ActiveSheet.Cells(z.Row, 50) = ActiveSheet.Cells(z.Row, 50).Value + ActiveSheet.Cells(z.Row, 21).Value
ActiveSheet.Cells(z.Row, 51) = ActiveSheet.Cells(z.Row, 51).Value + ActiveSheet.Cells(z.Row, 22).Value
ActiveSheet.Cells(z.Row, 52) = ActiveSheet.Cells(z.Row, 52).Value + ActiveSheet.Cells(z.Row, 23).Value
ActiveSheet.Cells(z.Row, 53) = ActiveSheet.Cells(z.Row, 53).Value + ActiveSheet.Cells(z.Row, 24).Value
ActiveSheet.Cells(z.Row, 54) = ActiveSheet.Cells(z.Row, 54).Value + ActiveSheet.Cells(z.Row, 25).Value
ActiveSheet.Cells(z.Row, 55) = ActiveSheet.Cells(z.Row, 55).Value + ActiveSheet.Cells(z.Row, 26).Value
ActiveSheet.Cells(z.Row, 56) = ActiveSheet.Cells(z.Row, 56).Value + ActiveSheet.Cells(z.Row, 27).Value
ActiveSheet.Cells(z.Row, 57) = ActiveSheet.Cells(z.Row, 57).Value + ActiveSheet.Cells(z.Row, 28).Value
ActiveSheet.Cells(z.Row, 58) = ActiveSheet.Cells(z.Row, 58).Value + ActiveSheet.Cells(z.Row, 29).Value
ActiveSheet.Cells(z.Row, 59) = ActiveSheet.Cells(z.Row, 59).Value + ActiveSheet.Cells(z.Row, 30).Value
ActiveSheet.Range("B2:AI32").ClearContents
End If
End With

Hajo_Zi
13.09.2011, 17:35
den Code im ersten Beitrag durch eine For Next Scheife ersetzen. Ich habe bei meiner ersten Antwort auch nicht den kompletten Code gesehen und darum bezog sich meine erste Antwort auch auf den ersten Beitrag.

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

Luschi
13.09.2011, 17:51
Hallo brain

versuch's mal so:

Dim ws As Worksheet, rg As Range, _
i As Integer
Set ws = ThisWorkbook.Worksheets("Januar")
ws.Activate
rg = ws.Range("A:A").Find(Date, , xlValues, xlWhole, xlByColumns, xlNext)
If Not rg Is Nothing Then
Zahlenmeldung.Edit rg.Row
For i = 31 To 59
ws.Cells(rg.Row, i).Value = ws.Cells(rg.Row, i).Value + ws.Cells(rg.Row, i - 29).Value
Next i
End If
ws.Range("B2:AI32").ClearContents

Set ws = Nothing
Set rg = Nothing

Gruß von Luschi
aus klein-Paris

Brain
13.09.2011, 18:54
Danke Luschi,

hab das gerade mal probiert, leider meckert er aber bei der Zeile

rg = ws.Range("A:A").Find(Date, , xlValues, xlWhole, xlByColumns, xlNext)

mit

Object variable or with block variable not set

Hier mal mein kompletter Code vereinfacht auf nur ein Tabellenblatt...was fehlt mir?

Sub Workbook_Open()
Dim strEingabe As String, lz As Long
Dim password
Dim ws As Worksheet, rg As Range, _
i As Integer

password = "sorglos"
For Each ws In Worksheets
ws.Unprotect password
If ThisWorkbook.ReadOnly Then
MsgBox "Nix da!"
ThisWorkbook.Close False
End If
Next

Set ws = ThisWorkbook.Worksheets("September")
ws.Activate
rg = ws.Range("A:A").Find(Date, , xlValues, xlWhole, xlByColumns, xlNext)
If Not rg Is Nothing Then
Zahlenmeldung.Edit rg.Row
For i = 31 To 63
ws.Cells(rg.Row, i).Value = ws.Cells(rg.Row, i).Value + ws.Cells(rg.Row, i - 33).Value
Next i
End If
ws.Range("B2:AI32").ClearContents

For Each ws In Worksheets
ws.Protect password
Next
ActiveWorkbook.Save

Luschi
13.09.2011, 18:58
Hallo Brain,

so sorry..., mein Fehler - wieder nur die Hälfte kopiert
so sollte es funktionieren:

Set rg = ws.Range("A:A").Find(Date, , xlValues, xlWhole, xlByColumns, xlNext)

Gruß von Luschi
aus klein-Paris

Brain
13.09.2011, 19:17
Jetzt meckert er zwar nicht mehr aber meine Userform öffnet er auch nicht.

Hier mal ein gekürzter Code meiner Userform...wo ist denn jetzt wieder das Problem?

Option Explicit
Dim zeile As Long

Private Sub GetFormSheet(z As Long)
txtB.Text = Cells(rg.Row, 2)
txtR.Text = Cells(rg.Row, 3)
End Sub

Private Sub SetToSheet(z As Long)
Cells(rg.Row, 2) = CDbl(txtB.Text)
Cells(rg.Row, 3) = CDbl(txtR.Text)
End Sub

Sub Edit(ByVal z As Long)
With Me
.Label1 = "Zahlen vom " & Cells(rg.Row, 1)
zeile = z
GetFormSheet zeile
.Show
End With
End Sub

Private Sub CommandButton1_Click()
If txtB = "" Then txtB.Value = 0
If txtR = "" Then txtR.Value = 0
SetToSheet zeile
Unload Me
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Luschi
13.09.2011, 20:03
Hallo Brain,

ich sehe nirgens einen Befehl zum Öffner der Userform, etwa so:
Userform1.Show

Man muß das Öffnen einer Userform von 'außen' anstoßen und nicht mit einem Code (Me.Show) im Klassenmodul der Userform

Gruß von Luschi
aus klein-Paris

Brain
13.09.2011, 21:07
Okay habs jetzt nach weiterem rumprobieren geschafft...das Ding läuft nun astrein wie ich es wollte.

Vielen vielen Dank habt mir sehr geholfen;-)