Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

spalten nach bedingungen mit vba ausblenden

344 views
Skip to first unread message

KHE / IWP

unread,
Jun 17, 2003, 11:42:14 AM6/17/03
to
Hallo NG,
ich habe in einer Tabelle von K1 bis GL1 verschiedene Werte stehen
mittels Makro will ich alle Spalten ausblenden, die nicht in zeile 1 einen
bestimmten Wert haben, dazu setze ich folgendes Makro ein:

Sub Makro1()
j = Range("d2").Value
makroa 'blended alle spalten zunächst ein
Range("K1").Select
Application.ScreenUpdating = False
For i = 0 To 200
If ActiveCell.Offset(rowOffset:=0, columnOffset:=i) <> j Then
ActiveCell.Offset(rowOffset:=0, columnOffset:=i).EntireColumn.Hidden =
True
End If
Next
Range("d2").Value = j
Application.ScreenUpdating = True
Selection.AutoFilter Field:=4, Criteria1:="x"
End Sub

der Code funktioniert sogar, aber ziemlich laaaaaaaaaaaaangsam
hat einer eine bessere idee?
mfg
Karl-Heinz

Melanie Breden

unread,
Jun 17, 2003, 2:07:34 PM6/17/03
to
Hallo Karl-Heinz,

"KHE / IWP" schrieb:


> ich habe in einer Tabelle von K1 bis GL1 verschiedene Werte stehen
> mittels Makro will ich alle Spalten ausblenden, die nicht in zeile 1 einen
> bestimmten Wert haben, dazu setze ich folgendes Makro ein:
>
> Sub Makro1()
> j = Range("d2").Value
> makroa 'blended alle spalten zunächst ein
> Range("K1").Select
> Application.ScreenUpdating = False
> For i = 0 To 200
> If ActiveCell.Offset(rowOffset:=0, columnOffset:=i) <> j Then
> ActiveCell.Offset(rowOffset:=0, columnOffset:=i).EntireColumn.Hidden =
> True
> End If
> Next
> Range("d2").Value = j
> Application.ScreenUpdating = True
> Selection.AutoFilter Field:=4, Criteria1:="x"
> End Sub
>

ich denke, du kommst um eine Schleife nicht herum, wenn sich der Wert in D2 immer wieder ändert?

Probier mal, ob diese schneller ist:

Sub Spalten()
Dim iCol As Integer

' alle Spalten einblenden
ActiveSheet.Columns.Hidden = False
Application.ScreenUpdating = False

For iCol = 11 To 194 ' K:GL
Columns(iCol).Hidden = Cells(1, iCol).Value <> Range("d2").Value
Next

Application.ScreenUpdating = True
Selection.AutoFilter Field:=4, Criteria1:="x"
End Sub

--
Mit freundlichen Grüßen
Melanie Breden

_____________________
[Microsoft MVP für Excel]

KHE / IWP

unread,
Jun 17, 2003, 2:22:25 PM6/17/03
to
hallo melanie,
kurz: deutlich schneller!
vielen dank für deine mühe
und schönen abend noch
mfg
karl-heinz

"Melanie Breden" <Melanie...@mvps.org> schrieb im Newsbeitrag
news:O9mAUtPN...@TK2MSFTNGP10.phx.gbl...

Melanie Breden

unread,
Jun 17, 2003, 2:50:30 PM6/17/03
to
Hallo Karl-Heinz,

"KHE / IWP" schrieb:


> hallo melanie,
> kurz: deutlich schneller!
> vielen dank für deine mühe
> und schönen abend noch

freut mich das es funzt :-) und danke dir für die Rückmeldung

0 new messages