ähnliche abfrage auf mehrere zellen
16.01.2004 10:04:32
Muck
ich habe ca. 60 prozeduren (für eine tabelle) die alle was sehr ähnliches machen.....der unterschied zwischen den prozeduren ist:
1.) sie fragen die daten in anderen zellen ab (s.u. zeile 17,20,23)
2.) sie schreiben die abgefragten daten in andere zellen rein (s.u. zeile 28)
kann man das irgendwie durch eine schleife verkürzen bzw. in eine prozedur schreiben!?
die prozeduren sehen wie folgt aus:
Sub Zelle_F3()
2 Dim wb1 As Workbook, wb2 As Workbook, Summe1 As Single
3 Dim Summe2 As Single, summe3 As Single
4 Dim wsfern As Worksheet, xx As Worksheet
5 'Eingabemaske deaktivieren
6 Application.EnableEvents = False
7 'Datei zum lesen öffnen
8 Workbooks.Open ThisWorkbook.Path & "\NL01 Hoffmann.xls"
9 'Eingabemaske aktivieren
10 Application.EnableEvents = True
11 Set wb1 = Workbooks("NL01 Hoffmann.xls")
12 Set wb2 = Workbooks("Auswertungtabelle.xls")
13 Set wsfern = wb1.Worksheets("Bewerber")
14 Set xx = wb2.Worksheets("NL1 Hoffmann")
15 'Die Summebildung Zeile 2 bis 120
16 For i = 2 To 120
17 If wsfern.Cells (i, 22) = "ja" Then ' 22 ist Spalte V
18 Summe1 = Summe1 + 1 'Summenbildung
19 End If
20 If wsfern.Cells(i, 16) = "AD" Then ' 16 Ist Spalte P
21 Summe2 = Summe2 + 1 'Summenbildung
22 End If
23 If wsfern.Cells(i, 19) = 101 Then ' 19 ist Spalte S
24 summe3 = summe3 + 1 'Summenbildung
25 End If
26 Next
27 'Summe in andere Datei üernehmen
28 xx.Cells(3, 6) = Summe1 * Summe2 * summe3
29 'Datei schliessen
30 Workbooks("NL01 Hoffmann.xls").Close savechanges:=False
End Sub
Mfg
Muck