Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1676to1680
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1676to1680
1676to1680
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA Vereinfachung

VBA Vereinfachung
18.02.2019 07:51:03
Gergö
Guten Morgen!
Brauch wieder einmal eure Hilfe,
Ich habe aus unterschiedlichen FOhren einen funktionierenden VBA Text erstellt, jedoch rechnet mein PC ziemlich lange.
Gibt es möglichkeiten, Wege den VBA Text zu vereinfachen um schnellere Ergebnise zu erhalten?
Hier der Text 
  • 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Erstellt in Bereich A10 bei Klick ein leeres K?stchen oder ein angehaktes K?stchen
Select Case Target.Column
Case 3
Select Case Target.Row
' Case Range("10:10000")
Case 10, 18, 36, 54, 57, 68, 78, 87, 95, 103, 111, 115, 136, 148, 155, 164, 170,  _
173, 179, 208, 216, 283, 293, 301, 307, 323, 333, 338, 353, 370, 376, 395, 423, 433, 462, 475, 494, 523, 533, 542, 560, 569, 584, 593, 603, 620, 638, 675, 692, 700, 705, 724, 727, 731, 735, 739, 743, 747
With Target(1, 1)
.Font.Name = "Wingdings" 'Zelle in Schriftart "Wingdings" formatieren
.Font.Size = 14 'Hier die Gr?sse anpassen !
.Value = IIf(.Value = Chr(168), Chr(254), Chr(168)) 'Wechselt zwischen leerem  _
und angehaktem K?stchen
End With
End Select
End Select
'Erstellt in Bereich C12:C248 bei Klick ein leeres K?stchen oder ein angehaktes K? _
stchen
Select Case Target.Column
Case 5
' Select Case Target.Row
'   Case 12, 13, 14, 15, 16, 17, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,  _
32, 33, 34, 35, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 55, 56, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 69, 70, 71, 72, 73, 74, 75, 76, 77, 79, 80, 81, 82, 83, 84, 85, 86, 88, 89, 90, 91, 92, 93, 94, 96, 97, 98, 99, 100, 101, 102, 104, 105, 106, 107, 108, 109, 110, 112, 113, 114, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 149, 150, 151, 152, 153, 154, 156, 157, 158, 159, 160, 161, 162, 163, 165, 166, 167, 168, 169, 171, 172, 174, 175, 176, 177, 178, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 202, 203, 204, 205, 206, 207, 209, 210, 211, 212, 213, 214, 215, 217, 218, 219, 220, 221, 222, 223, 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, 247, 248
With Target(1, 1)
.Font.Name = "Wingdings" 'Zelle in Schriftart "Wingdings" formatieren
.Font.Size = 14 'Hier die Gr?sse anpassen !
.Value = IIf(.Value = Chr(168), Chr(254), Chr(168)) 'Wechselt zwischen leerem  _
und angehaktem K?stchen
End With
'  End Select
End Select
'Erstellt in Bereich C249:446 bei Klick ein leeres K?stchen oder ein angehaktes K?stchen
Select Case Target.Column
Case 5
'   Select Case Target.Row
'   Case 249, 250, 251, 252, 253, 254, 255, 256, 257, 258, 259, 260, 261, 262, 263,  _
264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, 281, 282, 284, 285, 286, 287, 288, 289, 290, 291, 292, 294, 295, 296, 297, 298, 299, 300, 302, 303, 304, 305, 306, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, 324, 325, 326, 327, 328, 329, 330, 331, 332, 334, 335, 336, 337, 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 354, 355, 356, 357, 358, 359, 360, 361, 362, 363, 364, 365, 366, 367, 368, 369, 371, 372, 373, 374, 375, 377, 378, 379, 380, 381, 382, 383, 384, 385, 386, 387, 388, 389, 390, 391, 392, 393, 394, 396, 397, 398, 399, 400, 401, 402, 403, 404, 405, 406, 407, 408, 409, 410, 411, 412, 413, 414, 415, 416, 417, 418, 419, 420, 421, 422, 424, 425, 426, 427, 428, 429, 430, 431, 432, 434, 435, 436, 437, 438, 439, 440, 441, 442, 443, 444, 445, 446
With Target(1, 1)
.Font.Name = "Wingdings" 'Zelle in Schriftart "Wingdings" formatieren
.Font.Size = 14 'Hier die Gr?sse anpassen !
.Value = IIf(.Value = Chr(168), Chr(254), Chr(168)) 'Wechselt zwischen leerem  _
und angehaktem K?stchen
End With
' End Select
End Select
'Erstellt in Bereich C504:720 bei Klick ein leeres K?stchen oder ein angehaktes K?stchen
Select Case Target.Column
Case 5
' Select Case Target.Row
'Case 504, 505, 506, 507, 508, 509, 510, 511, 512, 513, 514, 515, 516, 517, 518, 519, 520, 521,  _
522, 524, 525, 526, 527, 528, 529, 530, 531, 532, 534, 535, 536, 537, 538, 539, 540, 541, 543, 544, 545, 546, 547, 548, 549, 550, 551, 552, 553, 554, 555, 556, 557, 558, 559, 561, 562, 563, 564, 565, 566, 567, 568, 570, 571, 572, 573, 574, 575, 576, 577, 578, 579, 580, 581, 582, 583, 585, 586, 587, 588, 589, 590, 591, 592, 594, 595, 596, 597, 598, 599, 600, 601, 602, 604, 605, 606, 607, 608, 609, 610, 611, 612, 613, 614, 615, 616, 617, 618, 619, 621, 622, 623, 624, 625, 626, 627, 628, 629, 630, 631, 632, 633, 634, 635, 636, 637, 639, 640, 641, 642, 643, 644, 645, 646, 647, 648, 649, 650, 651, 652, 653, 654, 655, 656, 657, 658, 659, 660, 661, 662, 663, 664, 665, 666, 667, 668, 669, 670, 671, 672, 673, 674, 676, 677, 678, 679, 680, 681, 682, 683, 684, 685, 686, 687, 688, 689, 690, 691, 693, 694, 695, 696, 697, 698, 699, 701, 702, 703, 704, 706, 707, 708, 709, 710, 711, 712, 713, 714, 715, 716, 717, 718, 719, 720
With Target(1, 1)
.Font.Name = "Wingdings" 'Zelle in Schriftart "Wingdings" formatieren
.Font.Size = 14 'Hier die Gr?sse anpassen !
.Value = IIf(.Value = Chr(168), Chr(254), Chr(168)) 'Wechselt zwischen leerem  _
und angehaktem K?stchen
End With
'End Select
End Select
'Erstellt in Bereich C721:760 bei Klick ein leeres K?stchen oder ein angehaktes K? _
stchen
Select Case Target.Column
Case 5
'    Select Case Target.Row
'Case 721, 722, 723, 725, 726, 728, 729, 730, 732, 733, 734, 736, 737, 738, 740, 741, 742, 744,  _
745, 746, 748, 749, 750, 751, 752, 753, 754, 755, 756, 757, 758, 759, 760
With Target(1, 1)
.Font.Name = "Wingdings" 'Zelle in Schriftart "Wingdings" formatieren
.Font.Size = 14 'Hier die Gr?sse anpassen !
.Value = IIf(.Value = Chr(168), Chr(254), Chr(168)) 'Wechselt zwischen leerem  _
und angehaktem K?stchen
End With
End Select
'   End Select
End Sub


    Private Sub Worksheet_Change(ByVal Target As Range)
If WorksheetFunction.CountIf(Range("c10"), "?") Then
Rows("11:17").Hidden = False
Else
Rows("11:17").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C18"), "?") Then
Rows("19:35").Hidden = False
Else
Rows("19:35").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C36"), "?") Then
Rows("37:53").Hidden = False
Else
Rows("37:53").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C54"), "?") Then
Rows("55:56").Hidden = False
Else
Rows("55:56").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C57"), "?") Then
Rows("58:67").Hidden = False
Else
Rows("58:67").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C68"), "?") Then
Rows("69:77").Hidden = False
Else
Rows("69:77").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C78"), "?") Then
Rows("79:86").Hidden = False
Else
Rows("79:86").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C87"), "?") Then
Rows("88:94").Hidden = False
Else
Rows("88:94").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C95"), "?") Then
Rows("96:102").Hidden = False
Else
Rows("96:102").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C103"), "?") Then
Rows("104:110").Hidden = False
Else
Rows("104:100").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C111"), "?") Then
Rows("112:114").Hidden = False
Else
Rows("112:114").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C115"), "?") Then
Rows("116:135").Hidden = False
Else
Rows("116:135").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C136"), "?") Then
Rows("137:147").Hidden = False
Else
Rows("137:147").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C148"), "?") Then
Rows("149:154").Hidden = False
Else
Rows("149:154").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C155"), "?") Then
Rows("156:163").Hidden = False
Else
Rows("156:163").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C164"), "?") Then
Rows("165:169").Hidden = False
Else
Rows("165:169").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C170"), "?") Then
Rows("171:172").Hidden = False
Else
Rows("171:172").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C173"), "?") Then
Rows("174:178").Hidden = False
Else
Rows("174:178").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C179"), "?") Then
Rows("180:207").Hidden = False
Else
Rows("180:207").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C208"), "?") Then
Rows("209:215").Hidden = False
Else
Rows("209:215").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C216"), "?") Then
Rows("217:282").Hidden = False
Else
Rows("217:282").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C283"), "?") Then
Rows("284:294").Hidden = False
Else
Rows("284:294").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C293"), "?") Then
Rows("294:300").Hidden = False
Else
Rows("294:300").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C301"), "?") Then
Rows("302:306").Hidden = False
Else
Rows("302:306").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C307"), "?") Then
Rows("308:322").Hidden = False
Rows(309).Hidden = False
Else
Rows("308:322").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C323"), "?") Then
Rows("324:332").Hidden = False
Else
Rows("324:332").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C333"), "?") Then
Rows("334:337").Hidden = False
Else
Rows("334:337").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C338"), "?") Then
Rows("339:352").Hidden = False
Else
Rows("339:352").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C353"), "?") Then
Rows("354:369").Hidden = False
Else
Rows("354:369").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C370"), "?") Then
Rows("371:375").Hidden = False
Else
Rows("371:375").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C376"), "?") Then
Rows("377:394").Hidden = False
Else
Rows("377:394").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C395"), "?") Then
Rows("396:422").Hidden = False
Else
Rows("396:422").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C423"), "?") Then
Rows("424:432").Hidden = False
Else
Rows("424:432").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C433"), "?") Then
Rows("434:461").Hidden = False
Else
Rows("434:461").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C462"), "?") Then
Rows("463:474").Hidden = False
Else
Rows("463:474").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C475"), "?") Then
Rows("476:493").Hidden = False
Else
Rows("476:493").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C494"), "?") Then
Rows("495:522").Hidden = False
Else
Rows("495:522").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C523"), "?") Then
Rows("524:532").Hidden = False
Else
Rows("524:532").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C533"), "?") Then
Rows("534:541").Hidden = False
Else
Rows("534:541").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C542"), "?") Then
Rows("543:559").Hidden = False
Else
Rows("543:559").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C560"), "?") Then
Rows("561:568").Hidden = False
Else
Rows("561:568").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C569"), "?") Then
Rows("570:583").Hidden = False
Else
Rows("570:583").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C584"), "?") Then
Rows("585:592").Hidden = False
Else
Rows("585:592").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C593"), "?") Then
Rows("594:602").Hidden = False
Else
Rows("594:602").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C603"), "?") Then
Rows("604:619").Hidden = False
Else
Rows("604:619").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C620"), "?") Then
Rows("621:637").Hidden = False
Else
Rows("621:637").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C638"), "?") Then
Rows("639:674").Hidden = False
Else
Rows("639:674").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C675"), "?") Then
Rows("676:691").Hidden = False
Else
Rows("676:691").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C692"), "?") Then
Rows("693:699").Hidden = False
Else
Rows("693:699").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C700"), "?") Then
Rows("701:704").Hidden = False
Else
Rows("701:704").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C705"), "?") Then
Rows("706:723").Hidden = False
Else
Rows("706:723").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C724"), "?") Then
Rows("725:726").Hidden = False
Else
Rows("725:726").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C727"), "?") Then
Rows("728:730").Hidden = False
Else
Rows("728:730").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C731"), "?") Then
Rows("732:734").Hidden = False
Else
Rows("732:734").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C735"), "?") Then
Rows("736:738").Hidden = False
Else
Rows("736:738").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C739"), "?") Then
Rows("740:742").Hidden = False
Else
Rows("740:742").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C743"), "?") Then
Rows("744:746").Hidden = False
Else
Rows("744:746").Hidden = True
End If
If WorksheetFunction.CountIf(Range("C747"), "?") Then
Rows("748:760").Hidden = False
Else
Rows("748:760").Hidden = True
End If
End Sub

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

    Betreff
    Datum
    Anwender
    Anzeige
    AW: VBA Vereinfachung
    18.02.2019 10:59:15
    Daniel
    Hallo Gergö,
    was soll dein Code denn machen? Du hast da diverse Male Target.Column Case 5 drin, dazu jede Menge auskommentiert. Sehr schwer zu lesen. Was willst du erreichen?
    Gruß
    Daniel
    AW: VBA Vereinfachung
    18.02.2019 11:37:41
    Gergö
    Hallo Daniel,
    Hier die Bsp. Datei
    https://www.herber.de/bbs/user/127716.xlsm
    AllgemeineFunktion
    Es soll eigentlich eine Auswahlmöglichkeit der Hauptgruppen und den zugehörigen Untergruppen werden. In einer möglichst kompakten Ansicht. Die Untergruppen sollen erst sichtbar aufgelistet werden wenn ein Hakerl bei der Hauptgruppe getätigt worden ist.
    Funktionsweise
    Sollte in der Spalte "C" die "Checkbox" geklickt werden so wird einerseits ein Hakerl gesetzt und die entsprechende Untergruppen eingeblendet die bis zu dem Zeitpunkt ausgeblendet waren. Ab da kann man auch jeder eingeblendeten Untergruppen ein Hakerl ind der Spalte "E" setzen.
    So kann ich eine abfrage für alle ausgewählten Haupt und Untergruppen erstellen, siehe Spalte L.
    Auskomentiert habe ich es damit es etwas schneller funktioniert.
    Die diversen Target.Column Case 5 sind deswegen so oft entstanden da ich einige male mehr Zeilenangaben gebraucht habe wie es zugelassen wird. Also habe ich es einfach kopiert und weitergeführt.
    Anzeige
    AW: VBA Vereinfachung
    18.02.2019 12:13:56
    Daniel
    Mir ist leider immer noch nicht wirklich klar, was du mit dem Code eigentlich bezweckst. Deine Tabelle ist ziemlich ausufernd, um es mal vorsichtig auszudrücken.
    Man kann einzelne Bereiche aktivieren oder deaktivieren (die "LG XX") und dann darin Unterkategorien auswählen ("ULG XX")? Und dann? Sollen als Ergebnis nur die ausgewählten Ober- und Unterkategorien dargestellt werden? Was wird dann damit gemacht?
    Ich könnte mir vorstellen, dass sich das Ganze mit Dropdowns oder "echten" Checkboxen oder anderen Möglichkeiten stark vereinfachen lässt. Das kommt aber ganz darauf an, wo die Reise hingehen soll.
    Anzeige
    AW: VBA Vereinfachung
    18.02.2019 13:24:42
    Daniel
    https://www.herber.de/bbs/user/127721.xlsm
    Hab dir mal als Beispiel was angefangen. So kannst du mit Checkboxen die einzelnen Abschnitte ein- und ausblenden. Müsstest du dann nur weiterführen bis zum Ende. Da ich nicht weiß, was sonst noch passieren soll, kann ich momentan leider nicht mehr tun!
    Grüße
    Daniel
    AW: VBA Vereinfachung
    18.02.2019 15:45:48
    Gergö
    Hallo Daniel,
    ja die Lösung funktioniert ansatzweise.
    Peter hat eine für den Rechner einfach ausführbare Version geschrieben.
    Vielen Dank für deine Zeit und mühe.
    mfg Gergö
    AW: VBA Vereinfachung
    18.02.2019 13:33:43
    Gergö
    Hallo Daniel,
    Die Datei ist noch in der Entwurfsphase, deswegen die Chaotik.
    Ja das ziel ist einfach alle ausgewählten Ober und Unterkategorien darzustellen.
    Dies brauche ich damit für die Jeweilige Baustelle gezielt nach den "LG" und "ULG" kosten anführen kann.
    Mir ist bis jetzt nur der weg unbekannt wie ich den ganzen VBA Text so vereinfache das mein einfacher PC in zumutbarer Schnelligkeit nach Auswahl der "LG XX" die dazugehörigen "ULG XX" aufgelistet werden.
    Mit einer WENN Bedingung kann ich dann alle ausgewählten "LeistungsGruppen" sammeln und untereinander aufgelistet haben.
    Die Herangehensweise ist entstanden da ich nicht weiß wie ich mehr als 700 Checkboxen einfüge mit der genauen Zellenverknüpfung. Per Hand war mir das Zuviel.
    Die WENN abfrage währe dann ja ganz gleich.
    MFG
    Gergö
    Anzeige
    AW: VBA Vereinfachung
    18.02.2019 14:41:36
    PeterK
    Hallo
    Verwende folgenden Code
    Microsoft Excel Objekt Tabelle1 
    Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
 
    Application.EnableEvents = False 
    Application.ScreenUpdating = False 
    Application.Calculation = xlManual 
    On Error GoTo Ende 
 
 
    Select Case Target.Row 
    Case 10, 18, 36, 54, 57, 68, 78, 87, 95, 103, 111, 115, 136, 148, 155, 164, 170, 173, 179, 208, 216, _
         283, 293, 301, 307, 323, 333, 338, 353, 370, 376, 395, 423, 433, 462, 475, 494, 523, 533, 542, _
         560, 569, 584, 593, 603, 620, 638, 675, 692, 700, 705, 724, 727, 731, 735, 739, 743, 748 
        If Target.Column = 3 Then 
            With Target(1, 1) 
                .Font.Name = "Wingdings"    'Zelle in Schriftart "Wingdings" formatieren 
                .Font.Size = 14             'Hier die Grösse anpassen ! 
                .Value = IIf(.Value = Chr(168), Chr(254), Chr(168))    'Wechselt zwischen leerem und angehaktem Kästchen 
            End With 
            CheckRows 
        End If 
 
    Case Else 
        If Target.Column = 5 Then 
            With Target(1, 1) 
                .Font.Name = "Wingdings"    'Zelle in Schriftart "Wingdings" formatieren 
                .Font.Size = 14             'Hier die Grösse anpassen ! 
                .Value = IIf(.Value = Chr(168), Chr(254), Chr(168))    'Wechselt zwischen leerem und angehaktem Kästchen 
            End With 
        End If 
 
    End Select 
 
Ende: 
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 
    Application.Calculation = xlAutomatic 
 
End Sub 
 
 
Private Sub CheckRows() 
 
    Call HideRange("C10", "11:17") 
    Call HideRange("C18", "19:35") 
    Call HideRange("C36", "37:53") 
    Call HideRange("C54", "55:56") 
    Call HideRange("C57", "58:67") 
    Call HideRange("C68", "69:77") 
    Call HideRange("C78", "79:86") 
    Call HideRange("C87", "88:94") 
    Call HideRange("C95", "96:102") 
    Call HideRange("C103", "104:100") 
    Call HideRange("C111", "112:114") 
    Call HideRange("C115", "116:135") 
    Call HideRange("C136", "137:147") 
    Call HideRange("C148", "149:154") 
    Call HideRange("C155", "156:163") 
    Call HideRange("C164", "165:169") 
    Call HideRange("C170", "171:172") 
    Call HideRange("C173", "174:178") 
    Call HideRange("C179", "180:207") 
    Call HideRange("C208", "209:215") 
    Call HideRange("C216", "217:282") 
    Call HideRange("C283", "284:294") 
    Call HideRange("C293", "294:300") 
    Call HideRange("C301", "302:306") 
    Call HideRange("C307", "308:322") 
    Call HideRange("C323", "324:332") 
    Call HideRange("C333", "334:337") 
    Call HideRange("C338", "339:352") 
    Call HideRange("C353", "354:369") 
    Call HideRange("C370", "371:375") 
    Call HideRange("C376", "377:394") 
    Call HideRange("C395", "396:422") 
    Call HideRange("C423", "424:432") 
    Call HideRange("C433", "434:461") 
    Call HideRange("C462", "463:474") 
    Call HideRange("C475", "476:493") 
    Call HideRange("C494", "495:522") 
    Call HideRange("C523", "524:532") 
    Call HideRange("C533", "534:541") 
    Call HideRange("C542", "543:559") 
    Call HideRange("C560", "561:568") 
    Call HideRange("C569", "570:583") 
    Call HideRange("C584", "585:592") 
    Call HideRange("C593", "594:602") 
    Call HideRange("C603", "604:619") 
    Call HideRange("C620", "621:637") 
    Call HideRange("C638", "639:674") 
    Call HideRange("C675", "676:691") 
    Call HideRange("C692", "693:699") 
    Call HideRange("C700", "701:704") 
    Call HideRange("C705", "706:723") 
    Call HideRange("C724", "725:726") 
    Call HideRange("C727", "728:730") 
    Call HideRange("C731", "732:734") 
    Call HideRange("C735", "736:738") 
    Call HideRange("C739", "740:742") 
    Call HideRange("C743", "744:746") 
    Call HideRange("C747", "748:760") 
 
End Sub 
 
Private Sub HideRange(CheckCell As String, HideRange As String) 
 
    If Range(CheckCell) = "þ" Then 
      Rows(HideRange).Hidden = False 
    Else 
      Rows(HideRange).Hidden = True 
    End If 
     
End Sub 
 
 
 
 
 
 
 
 
 
 
    

    VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
    Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

    Anzeige
    AW: VBA Vereinfachung
    18.02.2019 15:43:50
    Gergö
    Hallo Peter,
    Viel angenehmer, funktioniert einwandfrei.
    Vielen Dank dir =)
    Erstaunlich was ihr alles mit VBA anstellen könnt.

    Links zu Excel-Dialogen

    CheckBox

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige