noch Faster :-)
19.03.2006 18:20:05
Reinhard
Hi Holger,
Funktion klappt jetzt, aber hat noch kleinen Haken, nach dem runterkopieren erscheint überall der Wert der Ausgangszelle, k.A. warum, deshalb Frage noch offen.
Deshalb musst du dann noch alles in Spalte E markieren, dann das makro tt ablaufen lassen. Warum das Makro (siehe auskommentierten 2eiler) nicht automatisch selbst selektieren kann ist mr auch unklar.
Nachstehend ist die Tabelle auf die sich der ode bezieht gepostet.
Daatei: https://www.herber.de/bbs/user/32028.xls
Option Explicit
Function SW(ber1, ByVal krit1, ber2, ByVal krit2, bersumme)
Application.Volatile
Dim n
If ber1.Cells.Count <> ber2.Cells.Count Then GoTo ungleich
If ber1.Columns.Count > 1 Or ber2.Columns.Count > 1 Then GoTo ungleich
For n = 1 To ber1.Rows.Count
If Cells(n, 1) = krit1 And ber2.Cells(n, 1) = krit2 Then
SW = SW + bersumme.Cells(n, 1)
End If
Next n
Exit Function
ungleich:
SW = "Bereiche ungleich groß oder zuviele spalten"
End Function
Sub tt()
Dim Zelle As Range
'Range("E2:E" & Range("e65536").End(xlUp).Row).Select
'MsgBox Selection.Address
For Each Zelle In Selection
SendKeys "{F2}", True
SendKeys "{ENTER}", True
Next Zelle
End Sub
Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Tabellenblattname: Tabelle1
A B C D E F G
1 1 10 2 Summe Krit 1 Krit 2
2 2 20 4 490 1 2
3 3 30 6 2 2
4 4 40 8 3 6
5 1 50 2 2 4
6 2 60 4
7 3 70 6
8 4 80 8
9 1 90 2
10 2 100 4
11 3 110 6
12 4 120 8
13 1 130 2
14 2 140 4
15 3 150 6
16 4 160 8
17 1 170 8
18 2 180 4
19 3 190 6
20 4 200 8
21 1 210 2
22 2 220 4
23 3 230 6
24 4 240 8
25 2 250 2
26 2 260 4
27 3 270 6
28 4 280 8
Benutzte Formeln:
E2: =SW($A$1:$A$28;F2;$C$1:$C$28;G2;$B$1:$B$28)
Tabelle eingefügt mit Reinhards Tabelleneinfüger Version 1.0