Anzeige
Archiv - Navigation
1672to1676
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
Inhaltsverzeichnis

aufgezeichnetes Makro vereinfachen

aufgezeichnetes Makro vereinfachen
31.01.2019 15:49:49
Christian
Hallo, habe mir zum schluss stehendes Makro aufgezeichnet. Sehr sehr verwirrend, hoffe einer von euch nimmt sich etwas Zeit und verkürzt das ganze auf das was wirklich gebraucht wird:
Was es tun soll:
1. Die Formeln, die in B1, C1, E1 und K1 stehen bis zum Ende der Datensätze kopieren.
2. ab Zeile 2 die Werte einfügen (damit wieder nur in Zeile 1 Formeln stehen).
3. den Inhalt von Spalte K in Spalet F kopieren und werte Einfügen, damit in F1 keine Formel steht.
4. Die Tabelle in der Reihenfolge Spalte C nach Alter absteigend, dann Spalte F nach Alter aufsteigend sortieren.
5. Die Formeln, die in G1, H1, I1 und J1 stehen bis zum Ende der Datensätze kopieren.
6. ab Zeile 2 die Werte einfügen (damit wieder nur in Zeile 1 Formeln stehen)
Geht das? Ich wäre euch sehr dankbar.
Hier noch das Makro, ich weiß ich hab noch ein paar mal zwischendurch gescrollt und rumgeklickt, das kann natürlich gelöscht werden:
Sub Makro3()
' Makro3 Makro
Range("B1:C1").Select
Selection.Copy
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 67
ActiveWindow.ScrollRow = 75
ActiveWindow.ScrollRow = 84
ActiveWindow.ScrollRow = 95
ActiveWindow.ScrollRow = 106
ActiveWindow.ScrollRow = 126
ActiveWindow.ScrollRow = 138
ActiveWindow.ScrollRow = 165
ActiveWindow.ScrollRow = 178
ActiveWindow.ScrollRow = 215
ActiveWindow.ScrollRow = 478
ActiveWindow.ScrollRow = 529
ActiveWindow.ScrollRow = 543
ActiveWindow.ScrollRow = 572
ActiveWindow.ScrollRow = 585
ActiveWindow.ScrollRow = 617
ActiveWindow.ScrollRow = 629
ActiveWindow.ScrollRow = 740
ActiveWindow.ScrollRow = 730
ActiveWindow.ScrollRow = 723
ActiveWindow.ScrollRow = 713
ActiveWindow.ScrollRow = 712
ActiveWindow.ScrollRow = 699
ActiveWindow.ScrollRow = 698
ActiveWindow.ScrollRow = 703
ActiveWindow.ScrollRow = 713
ActiveWindow.ScrollRow = 723
ActiveWindow.ScrollRow = 736
ActiveWindow.ScrollRow = 767
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = 995
ActiveWindow.ScrollRow = 1010
ActiveWindow.ScrollRow = 1016
ActiveWindow.ScrollRow = 1019
ActiveWindow.ScrollRow = 1024
ActiveWindow.ScrollRow = 1030
ActiveWindow.ScrollRow = 1035
ActiveWindow.ScrollRow = 1043
Range("B1:C1080").Select
ActiveSheet.Paste
Range("B2:C2").Select
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 41
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 95
ActiveWindow.ScrollRow = 113
ActiveWindow.ScrollRow = 172
ActiveWindow.ScrollRow = 213
ActiveWindow.ScrollRow = 312
ActiveWindow.ScrollRow = 333
ActiveWindow.ScrollRow = 695
ActiveWindow.ScrollRow = 737
ActiveWindow.ScrollRow = 789
ActiveWindow.ScrollRow = 800
ActiveWindow.ScrollRow = 1020
ActiveWindow.ScrollRow = 1037
ActiveWindow.ScrollRow = 1043
Range("B2:C1080").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E1").Select
Application.CutCopyMode = False
Selection.Copy
Range("E2").Select
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 71
ActiveWindow.ScrollRow = 81
ActiveWindow.ScrollRow = 92
ActiveWindow.ScrollRow = 103
ActiveWindow.ScrollRow = 131
ActiveWindow.ScrollRow = 143
ActiveWindow.ScrollRow = 169
ActiveWindow.ScrollRow = 179
ActiveWindow.ScrollRow = 200
ActiveWindow.ScrollRow = 210
ActiveWindow.ScrollRow = 231
ActiveWindow.ScrollRow = 238
ActiveWindow.ScrollRow = 578
ActiveWindow.ScrollRow = 599
ActiveWindow.ScrollRow = 616
ActiveWindow.ScrollRow = 647
ActiveWindow.ScrollRow = 661
ActiveWindow.ScrollRow = 795
ActiveWindow.ScrollRow = 805
ActiveWindow.ScrollRow = 821
ActiveWindow.ScrollRow = 833
ActiveWindow.ScrollRow = 838
ActiveWindow.ScrollRow = 843
ActiveWindow.ScrollRow = 847
ActiveWindow.ScrollRow = 851
ActiveWindow.ScrollRow = 858
ActiveWindow.ScrollRow = 862
ActiveWindow.ScrollRow = 866
ActiveWindow.ScrollRow = 871
ActiveWindow.ScrollRow = 875
ActiveWindow.ScrollRow = 882
ActiveWindow.ScrollRow = 886
ActiveWindow.ScrollRow = 890
ActiveWindow.ScrollRow = 892
ActiveWindow.ScrollRow = 895
ActiveWindow.ScrollRow = 899
ActiveWindow.ScrollRow = 902
ActiveWindow.ScrollRow = 903
ActiveWindow.ScrollRow = 907
ActiveWindow.ScrollRow = 913
ActiveWindow.ScrollRow = 916
ActiveWindow.ScrollRow = 920
ActiveWindow.ScrollRow = 924
ActiveWindow.ScrollRow = 928
ActiveWindow.ScrollRow = 934
ActiveWindow.ScrollRow = 938
ActiveWindow.ScrollRow = 941
ActiveWindow.ScrollRow = 944
ActiveWindow.ScrollRow = 945
ActiveWindow.ScrollRow = 950
ActiveWindow.ScrollRow = 951
ActiveWindow.ScrollRow = 954
ActiveWindow.ScrollRow = 955
ActiveWindow.ScrollRow = 959
ActiveWindow.ScrollRow = 964
ActiveWindow.ScrollRow = 966
ActiveWindow.ScrollRow = 971
ActiveWindow.ScrollRow = 974
ActiveWindow.ScrollRow = 979
ActiveWindow.ScrollRow = 983
ActiveWindow.ScrollRow = 985
ActiveWindow.ScrollRow = 988
ActiveWindow.ScrollRow = 990
ActiveWindow.ScrollRow = 992
ActiveWindow.ScrollRow = 995
ActiveWindow.ScrollRow = 996
ActiveWindow.ScrollRow = 999
ActiveWindow.ScrollRow = 1003
ActiveWindow.ScrollRow = 1004
ActiveWindow.ScrollRow = 1009
ActiveWindow.ScrollRow = 1010
ActiveWindow.ScrollRow = 1013
ActiveWindow.ScrollRow = 1016
ActiveWindow.ScrollRow = 1017
ActiveWindow.ScrollRow = 1020
ActiveWindow.ScrollRow = 1021
ActiveWindow.ScrollRow = 1023
ActiveWindow.ScrollRow = 1024
ActiveWindow.ScrollRow = 1028
ActiveWindow.ScrollRow = 1033
ActiveWindow.ScrollRow = 1038
ActiveWindow.ScrollRow = 1041
ActiveWindow.ScrollRow = 1043
Range("E2:E1080").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 20
ActiveWindow.ScrollRow = 62
ActiveWindow.ScrollRow = 84
ActiveWindow.ScrollRow = 113
ActiveWindow.ScrollRow = 150
ActiveWindow.ScrollRow = 210
ActiveWindow.ScrollRow = 269
ActiveWindow.ScrollRow = 364
ActiveWindow.ScrollRow = 403
ActiveWindow.ScrollRow = 745
ActiveWindow.ScrollRow = 757
ActiveWindow.ScrollRow = 755
ActiveWindow.ScrollRow = 752
ActiveWindow.ScrollRow = 747
ActiveWindow.ScrollRow = 745
ActiveWindow.ScrollRow = 744
ActiveWindow.ScrollRow = 743
ActiveWindow.ScrollRow = 741
ActiveWindow.ScrollRow = 740
ActiveWindow.ScrollRow = 737
ActiveWindow.ScrollRow = 733
ActiveWindow.ScrollRow = 721
ActiveWindow.ScrollRow = 720
ActiveWindow.ScrollRow = 719
ActiveWindow.ScrollRow = 716
ActiveWindow.ScrollRow = 717
ActiveWindow.ScrollRow = 719
ActiveWindow.ScrollRow = 720
ActiveWindow.ScrollRow = 724
ActiveWindow.ScrollRow = 728
ActiveWindow.ScrollRow = 731
ActiveWindow.ScrollRow = 734
ActiveWindow.ScrollRow = 738
ActiveWindow.ScrollRow = 743
ActiveWindow.ScrollRow = 750
ActiveWindow.ScrollRow = 755
ActiveWindow.ScrollRow = 757
ActiveWindow.ScrollRow = 755
ActiveWindow.ScrollRow = 752
ActiveWindow.ScrollRow = 724
ActiveWindow.ScrollRow = 723
ActiveWindow.ScrollRow = 726
ActiveWindow.ScrollRow = 727
ActiveWindow.ScrollRow = 730
ActiveWindow.ScrollRow = 741
ActiveWindow.ScrollRow = 751
ActiveWindow.ScrollRow = 765
ActiveWindow.ScrollRow = 779
ActiveWindow.ScrollRow = 796
ActiveWindow.ScrollRow = 844
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = 1043
Range("K1:K1080").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Range("K2").Select
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 88
ActiveWindow.ScrollRow = 102
ActiveWindow.ScrollRow = 153
ActiveWindow.ScrollRow = 177
ActiveWindow.ScrollRow = 202
ActiveWindow.ScrollRow = 215
ActiveWindow.ScrollRow = 260
ActiveWindow.ScrollRow = 275
ActiveWindow.ScrollRow = 289
ActiveWindow.ScrollRow = 317
ActiveWindow.ScrollRow = 333
ActiveWindow.ScrollRow = 391
ActiveWindow.ScrollRow = 755
ActiveWindow.ScrollRow = 754
ActiveWindow.ScrollRow = 748
ActiveWindow.ScrollRow = 731
ActiveWindow.ScrollRow = 717
ActiveWindow.ScrollRow = 695
ActiveWindow.ScrollRow = 686
ActiveWindow.ScrollRow = 671
ActiveWindow.ScrollRow = 655
ActiveWindow.ScrollRow = 634
ActiveWindow.ScrollRow = 633
ActiveWindow.ScrollRow = 640
ActiveWindow.ScrollRow = 644
ActiveWindow.ScrollRow = 671
ActiveWindow.ScrollRow = 686
ActiveWindow.ScrollRow = 716
ActiveWindow.ScrollRow = 731
ActiveWindow.ScrollRow = 747
ActiveWindow.ScrollRow = 755
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = 645
ActiveWindow.ScrollRow = 612
ActiveWindow.ScrollRow = 610
ActiveWindow.ScrollRow = 616
ActiveWindow.ScrollRow = 621
ActiveWindow.ScrollRow = 623
ActiveWindow.ScrollRow = 624
ActiveWindow.ScrollRow = 626
ActiveWindow.ScrollRow = 627
ActiveWindow.ScrollRow = 629
ActiveWindow.ScrollRow = 630
ActiveWindow.ScrollRow = 631
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = 755
ActiveWindow.ScrollRow = 754
ActiveWindow.ScrollRow = 751
ActiveWindow.ScrollRow = 750
ActiveWindow.ScrollRow = 748
ActiveWindow.ScrollRow = 752
ActiveWindow.ScrollRow = 755
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = 755
ActiveWindow.ScrollRow = 737
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollRow = 926
ActiveWindow.ScrollRow = 930
ActiveWindow.ScrollRow = 933
ActiveWindow.ScrollRow = 935
ActiveWindow.ScrollRow = 938
ActiveWindow.ScrollRow = 937
ActiveWindow.ScrollRow = 935
ActiveWindow.ScrollRow = 934
ActiveWindow.ScrollRow = 933
ActiveWindow.ScrollRow = 935
ActiveWindow.ScrollRow = 937
ActiveWindow.ScrollRow = 941
ActiveWindow.ScrollRow = 952
ActiveWindow.ScrollRow = 962
ActiveWindow.ScrollRow = 964
ActiveWindow.ScrollRow = 968
ActiveWindow.ScrollRow = 974
ActiveWindow.ScrollRow = 978
ActiveWindow.ScrollRow = 982
ActiveWindow.ScrollRow = 983
ActiveWindow.ScrollRow = 985
ActiveWindow.ScrollRow = 989
ActiveWindow.ScrollRow = 992
ActiveWindow.ScrollRow = 999
ActiveWindow.ScrollRow = 1006
ActiveWindow.ScrollRow = 1010
ActiveWindow.ScrollRow = 1016
ActiveWindow.ScrollRow = 1023
ActiveWindow.ScrollRow = 1033
ActiveWindow.ScrollRow = 1037
ActiveWindow.ScrollRow = 1041
ActiveWindow.ScrollRow = 1043
Range("K2:K1080").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("K:K").Select
Application.CutCopyMode = False
Selection.Copy
Columns("F:F").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1:K1080").Select
Range("B7").Activate
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Ergebnis").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Ergebnis").Sort.SortFields.Add2 Key:=Range( _
"C1:C1080"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Ergebnis").Sort.SortFields.Add2 Key:=Range( _
"F1:F1080"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Ergebnis").Sort
.SetRange Range("A1:K1080")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B2").Select
Selection.Copy
Range("B1").Select
ActiveSheet.Paste
Range("C2").Select
Application.CutCopyMode = False
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Range("E2").Select
Application.CutCopyMode = False
Selection.Copy
Range("E1").Select
ActiveSheet.Paste
Range("G2").Select
Application.CutCopyMode = False
Selection.Copy
Range("G1").Select
ActiveSheet.Paste
Range("H2").Select
Application.CutCopyMode = False
Selection.Copy
Range("H1").Select
ActiveSheet.Paste
Range("I2").Select
Application.CutCopyMode = False
Selection.Copy
Range("I1").Select
ActiveSheet.Paste
Range("J2").Select
Application.CutCopyMode = False
Selection.Copy
Range("J1").Select
ActiveSheet.Paste
Range("K2").Select
Application.CutCopyMode = False
Selection.Copy
Range("K1").Select
ActiveSheet.Paste
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G1:J1").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 22
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 51
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 70
ActiveWindow.ScrollRow = 74
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 88
ActiveWindow.ScrollRow = 95
ActiveWindow.ScrollRow = 109
ActiveWindow.ScrollRow = 115
ActiveWindow.ScrollRow = 119
ActiveWindow.ScrollRow = 125
ActiveWindow.ScrollRow = 136
ActiveWindow.ScrollRow = 140
ActiveWindow.ScrollRow = 144
ActiveWindow.ScrollRow = 147
ActiveWindow.ScrollRow = 151
ActiveWindow.ScrollRow = 158
ActiveWindow.ScrollRow = 163
ActiveWindow.ScrollRow = 165
ActiveWindow.ScrollRow = 168
ActiveWindow.ScrollRow = 175
ActiveWindow.ScrollRow = 180
ActiveWindow.ScrollRow = 184
ActiveWindow.ScrollRow = 188
ActiveWindow.ScrollRow = 191
ActiveWindow.ScrollRow = 194
ActiveWindow.ScrollRow = 195
ActiveWindow.ScrollRow = 198
ActiveWindow.ScrollRow = 199
ActiveWindow.ScrollRow = 202
ActiveWindow.ScrollRow = 203
ActiveWindow.ScrollRow = 205
ActiveWindow.ScrollRow = 206
ActiveWindow.ScrollRow = 209
ActiveWindow.ScrollRow = 211
ActiveWindow.ScrollRow = 213
ActiveWindow.ScrollRow = 216
ActiveWindow.ScrollRow = 218
ActiveWindow.ScrollRow = 219
ActiveWindow.ScrollRow = 220
ActiveWindow.ScrollRow = 223
ActiveWindow.ScrollRow = 225
ActiveWindow.ScrollRow = 226
ActiveWindow.ScrollRow = 227
ActiveWindow.ScrollRow = 229
ActiveWindow.ScrollRow = 230
ActiveWindow.ScrollRow = 232
ActiveWindow.ScrollRow = 233
ActiveWindow.ScrollRow = 234
ActiveWindow.ScrollRow = 236
ActiveWindow.ScrollRow = 237
ActiveWindow.ScrollRow = 239
ActiveWindow.ScrollRow = 240
ActiveWindow.ScrollRow = 243
ActiveWindow.ScrollRow = 244
ActiveWindow.ScrollRow = 247
ActiveWindow.ScrollRow = 250
ActiveWindow.ScrollRow = 251
ActiveWindow.ScrollRow = 253
ActiveWindow.ScrollRow = 254
ActiveWindow.ScrollRow = 258
ActiveWindow.ScrollRow = 260
ActiveWindow.ScrollRow = 261
ActiveWindow.ScrollRow = 263
ActiveWindow.ScrollRow = 264
ActiveWindow.ScrollRow = 265
ActiveWindow.ScrollRow = 268
ActiveWindow.ScrollRow = 270
ActiveWindow.ScrollRow = 271
ActiveWindow.ScrollRow = 274
ActiveWindow.ScrollRow = 277
ActiveWindow.ScrollRow = 278
ActiveWindow.ScrollRow = 280
ActiveWindow.ScrollRow = 281
ActiveWindow.ScrollRow = 282
ActiveWindow.ScrollRow = 284
ActiveWindow.ScrollRow = 287
ActiveWindow.ScrollRow = 289
ActiveWindow.ScrollRow = 291
ActiveWindow.ScrollRow = 294
ActiveWindow.ScrollRow = 296
ActiveWindow.ScrollRow = 299
ActiveWindow.ScrollRow = 302
ActiveWindow.ScrollRow = 304
ActiveWindow.ScrollRow = 306
ActiveWindow.ScrollRow = 309
ActiveWindow.ScrollRow = 311
ActiveWindow.ScrollRow = 313
ActiveWindow.ScrollRow = 318
ActiveWindow.ScrollRow = 319
ActiveWindow.ScrollRow = 323
ActiveWindow.ScrollRow = 326
ActiveWindow.ScrollRow = 329
ActiveWindow.ScrollRow = 335
ActiveWindow.ScrollRow = 337
ActiveWindow.ScrollRow = 340
ActiveWindow.ScrollRow = 344
ActiveWindow.ScrollRow = 347
ActiveWindow.ScrollRow = 351
ActiveWindow.ScrollRow = 354
ActiveWindow.ScrollRow = 357
ActiveWindow.ScrollRow = 360
ActiveWindow.ScrollRow = 366
ActiveWindow.ScrollRow = 368
ActiveWindow.ScrollRow = 373
ActiveWindow.ScrollRow = 375
ActiveWindow.ScrollRow = 380
ActiveWindow.ScrollRow = 387
ActiveWindow.ScrollRow = 392
ActiveWindow.ScrollRow = 395
ActiveWindow.ScrollRow = 399
ActiveWindow.ScrollRow = 404
ActiveWindow.ScrollRow = 409
ActiveWindow.ScrollRow = 412
ActiveWindow.ScrollRow = 416
ActiveWindow.ScrollRow = 419
ActiveWindow.ScrollRow = 426
ActiveWindow.ScrollRow = 430
ActiveWindow.ScrollRow = 433
ActiveWindow.ScrollRow = 436
ActiveWindow.ScrollRow = 439
ActiveWindow.ScrollRow = 444
ActiveWindow.ScrollRow = 446
ActiveWindow.ScrollRow = 449
ActiveWindow.ScrollRow = 452
ActiveWindow.ScrollRow = 453
ActiveWindow.ScrollRow = 456
ActiveWindow.ScrollRow = 459
ActiveWindow.ScrollRow = 460
ActiveWindow.ScrollRow = 461
ActiveWindow.ScrollRow = 463
ActiveWindow.ScrollRow = 467
ActiveWindow.ScrollRow = 470
ActiveWindow.ScrollRow = 473
ActiveWindow.ScrollRow = 475
ActiveWindow.ScrollRow = 478
ActiveWindow.ScrollRow = 481
ActiveWindow.ScrollRow = 484
ActiveWindow.ScrollRow = 487
ActiveWindow.ScrollRow = 491
ActiveWindow.ScrollRow = 499
ActiveWindow.ScrollRow = 505
ActiveWindow.ScrollRow = 509
ActiveWindow.ScrollRow = 515
ActiveWindow.ScrollRow = 519
ActiveWindow.ScrollRow = 529
ActiveWindow.ScrollRow = 536
ActiveWindow.ScrollRow = 543
ActiveWindow.ScrollRow = 549
ActiveWindow.ScrollRow = 557
ActiveWindow.ScrollRow = 569
ActiveWindow.ScrollRow = 576
ActiveWindow.ScrollRow = 581
ActiveWindow.ScrollRow = 587
ActiveWindow.ScrollRow = 594
ActiveWindow.ScrollRow = 601
ActiveWindow.ScrollRow = 605
ActiveWindow.ScrollRow = 611
ActiveWindow.ScrollRow = 615
ActiveWindow.ScrollRow = 625
ActiveWindow.ScrollRow = 631
ActiveWindow.ScrollRow = 635
ActiveWindow.ScrollRow = 639
ActiveWindow.ScrollRow = 642
ActiveWindow.ScrollRow = 646
ActiveWindow.ScrollRow = 647
ActiveWindow.ScrollRow = 649
ActiveWindow.ScrollRow = 653
ActiveWindow.ScrollRow = 656
ActiveWindow.ScrollRow = 662
ActiveWindow.ScrollRow = 666
ActiveWindow.ScrollRow = 669
ActiveWindow.ScrollRow = 673
ActiveWindow.ScrollRow = 676
ActiveWindow.ScrollRow = 681
ActiveWindow.ScrollRow = 686
ActiveWindow.ScrollRow = 688
ActiveWindow.ScrollRow = 691
ActiveWindow.ScrollRow = 694
ActiveWindow.ScrollRow = 698
ActiveWindow.ScrollRow = 701
ActiveWindow.ScrollRow = 705
ActiveWindow.ScrollRow = 708
ActiveWindow.ScrollRow = 717
ActiveWindow.ScrollRow = 721
ActiveWindow.ScrollRow = 725
ActiveWindow.ScrollRow = 729
ActiveWindow.ScrollRow = 733
ActiveWindow.ScrollRow = 739
ActiveWindow.ScrollRow = 743
ActiveWindow.ScrollRow = 746
ActiveWindow.ScrollRow = 750
ActiveWindow.ScrollRow = 753
ActiveWindow.ScrollRow = 760
ActiveWindow.ScrollRow = 764
ActiveWindow.ScrollRow = 769
ActiveWindow.ScrollRow = 773
ActiveWindow.ScrollRow = 777
ActiveWindow.ScrollRow = 784
ActiveWindow.ScrollRow = 788
ActiveWindow.ScrollRow = 794
ActiveWindow.ScrollRow = 798
ActiveWindow.ScrollRow = 808
ActiveWindow.ScrollRow = 812
ActiveWindow.ScrollRow = 817
ActiveWindow.ScrollRow = 822
ActiveWindow.ScrollRow = 825
ActiveWindow.ScrollRow = 832
ActiveWindow.ScrollRow = 881
ActiveWindow.ScrollRow = 888
ActiveWindow.ScrollRow = 897
ActiveWindow.ScrollRow = 900
ActiveWindow.ScrollRow = 904
ActiveWindow.ScrollRow = 907
ActiveWindow.ScrollRow = 911
ActiveWindow.ScrollRow = 914
ActiveWindow.ScrollRow = 917
ActiveWindow.ScrollRow = 921
ActiveWindow.ScrollRow = 924
ActiveWindow.ScrollRow = 925
ActiveWindow.ScrollRow = 928
ActiveWindow.ScrollRow = 932
ActiveWindow.ScrollRow = 934
ActiveWindow.ScrollRow = 936
ActiveWindow.ScrollRow = 938
ActiveWindow.ScrollRow = 941
ActiveWindow.ScrollRow = 942
ActiveWindow.ScrollRow = 945
ActiveWindow.ScrollRow = 948
ActiveWindow.ScrollRow = 949
ActiveWindow.ScrollRow = 952
ActiveWindow.ScrollRow = 953
ActiveWindow.ScrollRow = 955
ActiveWindow.ScrollRow = 958
ActiveWindow.ScrollRow = 959
ActiveWindow.ScrollRow = 962
ActiveWindow.ScrollRow = 963
ActiveWindow.ScrollRow = 965
ActiveWindow.ScrollRow = 969
ActiveWindow.ScrollRow = 973
ActiveWindow.ScrollRow = 976
ActiveWindow.ScrollRow = 980
ActiveWindow.ScrollRow = 984
ActiveWindow.ScrollRow = 989
ActiveWindow.ScrollRow = 991
ActiveWindow.ScrollRow = 994
ActiveWindow.ScrollRow = 996
ActiveWindow.ScrollRow = 997
ActiveWindow.ScrollRow = 1001
ActiveWindow.ScrollRow = 1004
ActiveWindow.ScrollRow = 1007
ActiveWindow.ScrollRow = 1010
ActiveWindow.ScrollRow = 1011
ActiveWindow.ScrollRow = 1014
ActiveWindow.ScrollRow = 1015
ActiveWindow.ScrollRow = 1017
ActiveWindow.ScrollRow = 1018
ActiveWindow.ScrollRow = 1020
ActiveWindow.ScrollRow = 1024
ActiveWindow.ScrollRow = 1029
ActiveWindow.ScrollRow = 1031
ActiveWindow.ScrollRow = 1035
ActiveWindow.ScrollRow = 1039
ActiveWindow.ScrollRow = 1041
ActiveWindow.ScrollRow = 1042
ActiveWindow.ScrollRow = 1044
Range("G1:J1080").Select
ActiveSheet.Paste
Range("G2").Select
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 95
ActiveWindow.ScrollRow = 110
ActiveWindow.ScrollRow = 146
ActiveWindow.ScrollRow = 201
ActiveWindow.ScrollRow = 319
ActiveWindow.ScrollRow = 354
ActiveWindow.ScrollRow = 419
ActiveWindow.ScrollRow = 432
ActiveWindow.ScrollRow = 481
ActiveWindow.ScrollRow = 681
ActiveWindow.ScrollRow = 725
ActiveWindow.ScrollRow = 756
ActiveWindow.ScrollRow = 788
ActiveWindow.ScrollRow = 807
ActiveWindow.ScrollRow = 824
ActiveWindow.ScrollRow = 838
ActiveWindow.ScrollRow = 846
ActiveWindow.ScrollRow = 873
ActiveWindow.ScrollRow = 893
ActiveWindow.ScrollRow = 903
ActiveWindow.ScrollRow = 908
ActiveWindow.ScrollRow = 976
ActiveWindow.ScrollRow = 987
ActiveWindow.ScrollRow = 997
ActiveWindow.ScrollRow = 1004
ActiveWindow.ScrollRow = 1010
ActiveWindow.ScrollRow = 1021
ActiveWindow.ScrollRow = 1028
ActiveWindow.ScrollRow = 1032
ActiveWindow.ScrollRow = 1034
ActiveWindow.ScrollRow = 1038
ActiveWindow.ScrollRow = 1041
ActiveWindow.ScrollRow = 1044
Range("G2:J1080").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
End Sub

29
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: aufgezeichnetes Makro vereinfachen
31.01.2019 15:56:55
Rudi
Hallo,
lösch erst mal alle ActiveWindow.ScrollRow-Zeilen. Die brauchst du nicht.
Dann sehen wir weiter.
Gruß
Rudi
AW: aufgezeichnetes Makro vereinfachen
31.01.2019 16:32:57
Daniel
Hi
aufgezeichneter Programmcode sollte immer überarbeitet werden, da viele Dinge, die wir Anwender so machen müssen weil wir mit der Maus arbeiten, im Marko nicht notwendig sind.
das allererste wäre das von Rudi schon angesprochene ScrollRow.
solche Zeilen kannst du ohne weiteres zu beachten einfach löschen.
das nächste wäre, dass es in VBA nicht notwendig ist, ein Objekt zu selektieren, bevor man einen Befehl darauf anwendet. Wir machen das so, weil wir mit der Maus erst das Objekt und dann den Befehl im Menü anklicken müssen, aber in VBA kann man den befehl direkt an das Objekt anhängen und aus
Range("B1:C1").Select
Selection.Copy

wird
Range("B1:C1").Copy
weitere Infos dazu hier:
https://www.online-excel.de/excel/singsel_vba.php?f=78
überarbeite deinen Code mal nach diesen Regeln, dann blickt du selber gleich viel besser durch deinen Code durch.
Gruß Daniel
Anzeige
AW: aufgezeichnetes Makro vereinfachen
31.01.2019 16:37:31
UweD
Hallo
so...
Sub Makro3()
     Range("B1:C1").Copy Range("B1:C1080")
     
     With Range("B2:C1080")
        .Value = .Value
     End With
    
     With Range("E2:E1080")
        .Value = .Value
     End With
    
     Range("K1").Copy Range("K1:K1080")
     
     With Range("K2:K1080")
        .Value = .Value
     End With
     
     Columns("F:F").Value = Columns("K:K").Value
     
     With ActiveWorkbook.Worksheets("Ergebnis").Sort
        .SortFields.Clear
        
        .SortFields.Add2 Key:=Range("C:C"), SortOn:=xlSortOnValues, Order:=xlAscending, _
            DataOption:=xlSortNormal
     
        .SortFields.Add2 Key:=Range("F:F"), SortOn:=xlSortOnValues, Order:=xlDescending, _
            DataOption:=xlSortNormal
         
         .SetRange Range("A1:K1080")
         .Header = xlGuess
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
     End With
     
     
     Range("B2:C2").Copy Range("B1:C1")
     
     Range("E2").Copy Range("E1")
     
     Range("G2:K2").Copy Range("G1:K1")
     
     With Rows("2:2")
        .Value = .Value
     End With
     
     Range("G1:J1").Copy Range("G1:J1080")
     
     With Range("G2:J1080")
        .Value = .Value
     End With
     
     Range("E2").Select
 End Sub

LG UweD
Anzeige
AW: aufgezeichnetes Makro vereinfachen
31.01.2019 16:54:15
Christian
Hallo Uwe.
Erstmal Danke für deine Mühe. Ich schreibe ungetestet etwas dazu da ich bein Arzt im Wartezimmer Sitze. Zum einen sieht es so aus als würde die Formel in e1 nicht kopiert werden. Lediglich ab e2 die Werte eingefüen. Das zweite ich hatte Ende der Datensätze geschrieben anstatt Zeile 1080 weil ich mich auf kein Ende festlegen wollte. Ich wollte das ganze später mit mehr teilen auch wiederholen können.
Zum Dritten hast du richtig festgestellt, dass ich nach dem sortieren Teile aus Zeile 2 nach Zeile 1 kopiert hab. Hintergedanke dessen war dass durch das sortieren die Formeln die vorher in zeile 1 waren in zeile 2 gewandert sind. Und danach in zeile 2 die Werte eingefügt hab. Somit standen die Formeln wieder in zeile 1. Aber auch das kann wenn ich das Makro ein weiteres mal ausführe eine andere als die 2. Zeile sein in die die Formeln wandern.
Gruß Christian
Anzeige
Code ohne Scrollen
31.01.2019 22:11:24
Christian
Hier wie gewünscht der Code ohne Scrollen
Sub Makro3()
' Makro3 Makro
Range("B1:C1").Copy
Range("B1:C1080").Select
ActiveSheet.Paste
Range("B2:C2").Select
Range("B2:C1080").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E1").Select
Application.CutCopyMode = False
Selection.Copy
Range("E2").Select
Range("E2:E1080").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K1").Select
Application.CutCopyMode = False
Selection.Copy
Range("K1:K1080").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Range("K2").Select
Range("K2:K1080").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("K:K").Select
Application.CutCopyMode = False
Selection.Copy
Columns("F:F").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1:K1080").Select
Range("B7").Activate
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Ergebnis").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Ergebnis").Sort.SortFields.Add2 Key:=Range( _
"C1:C1080"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
ActiveWorkbook.Worksheets("Ergebnis").Sort.SortFields.Add2 Key:=Range( _
"F1:F1080"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Ergebnis").Sort
.SetRange Range("A1:K1080")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B2").Select
Selection.Copy
Range("B1").Select
ActiveSheet.Paste
Range("C2").Select
Application.CutCopyMode = False
Selection.Copy
Range("C1").Select
ActiveSheet.Paste
Range("E2").Select
Application.CutCopyMode = False
Selection.Copy
Range("E1").Select
ActiveSheet.Paste
Range("G2").Select
Application.CutCopyMode = False
Selection.Copy
Range("G1").Select
ActiveSheet.Paste
Range("H2").Select
Application.CutCopyMode = False
Selection.Copy
Range("H1").Select
ActiveSheet.Paste
Range("I2").Select
Application.CutCopyMode = False
Selection.Copy
Range("I1").Select
ActiveSheet.Paste
Range("J2").Select
Application.CutCopyMode = False
Selection.Copy
Range("J1").Select
ActiveSheet.Paste
Range("K2").Select
Application.CutCopyMode = False
Selection.Copy
Range("K1").Select
ActiveSheet.Paste
Rows("2:2").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G1:J1").Select
Application.CutCopyMode = False
Selection.Copy
Range("G1:J1080").Select
ActiveSheet.Paste
Range("G2").Select
Range("G2:J1080").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E2").Select
End Sub

Anzeige
AW: Code ohne Scrollen
31.01.2019 22:41:01
Werner
Hallo Christian,
und in welcher Spalte bitte kann die letzte Zeile ermittelt werden, bis wohin immer kopiert werden soll?
Gruß Werner
AW: Code ohne Scrollen
31.01.2019 22:45:53
Christian
Hallo Werner,
sorry hatte ich nicht dran gedacht, das muss eine lückenlos gefüllte sein oder? Dann kannst du A bis E nehmen, eine der 5 Spalten.
Gruß
Christian
AW: Code ohne Scrollen
31.01.2019 22:52:41
Werner
Hallo Christian,
dann teste mal. Hab jetzt nur deinen aufgezeichneten Code überarbeitet.
Sub Makro3()
Dim loLetzte As Long
Application.ScreenUpdating = False
With Worksheets("Ergebnis")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("B1:C1").Copy .Range("B1:C" & loLetzte)
.Range("B2:C" & loLetzte).Value = .Range("B2:C" & loLetzte).Value
.Range("E1").Copy .Range("E2:E" & loLetzte)
.Range("E2:E" & loLetzte).Value = .Range("E2:E" & loLetzte).Value
.Range("K1").Copy .Range("K1:K" & loLetzte)
.Range("K2:K" & loLetzte).Value = .Range("K2:K" & loLetzte).Value
.Columns("K:K").Copy
.Columns("F:F").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("C1:C" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range("F1:F" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:K" & loLetzte)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
.Range("B2:C2").Copy .Range("B1")
.Range("E2").Copy .Range("E1")
.Range("G2:K2").Copy .Range("G1")
.Rows("2:2").Value = .Rows("2:2").Value
.Range("G1:J1").Copy .Range("G2:J" & loLetzte)
.Range("E2").Select
End With
End Sub
Gruß Werner
Anzeige
AW: Code ohne Scrollen
31.01.2019 23:03:26
Christian
Hallo Werner,
.Range("B2:C2").Copy .Range("B1")
.Range("E2").Copy .Range("E1")
.Range("G2:K2").Copy .Range("G1")
hier steckt noch der Haken, wie gesagt das war in dem Makro Zeile 2, weil die Formeln durch das Sortieren in zeile 2 gewandert sind und dieser Teil des Makros sie wieder in Zeile 1 bringt, aber das kann bei jedem neuen Ausführen des Makros eine andere Zeile sein, genauso wie die Formeln auch in Zeile 1 nach dem Sortieren stehengeblieben sein können.
Gruß
Christian
AW: Code ohne Scrollen
31.01.2019 23:19:16
Werner
Hallo Christian,
das ganze wird zum Gestochere im Nebel. Die ganze Herumkopiererei von Formeln könnte man sich wahrscheinlich sparen, indem man ganz einfach die Formeln via VBA in den Bereich schreibt und danach die Formeln durch die jeweiligen Werte ersetzt.
Die Formeln kennst aber nur du.
Was hälst du davon mal Butter bei die Fische. Lade doch mal deine Mappe (ggf. mit anonymisierten Daten) und deinen Formeln hier hoch.
Gruß Werner
Anzeige
AW: Code ohne Scrollen
01.02.2019 07:19:47
Christian
Hallo Werner,
kein Problem:
https://www.herber.de/bbs/user/127348.xlsx
Da sind die Formeln drin in Zeile 1.
Nochmal zur allgemeinen Erklärung.
Der Hintergedanke weshalb ich das überhaupt mache, ist, wenn die Tabelle mal fertig ist rechne ich mit ca. 15000 Zeilen, ich rechne aufgrund der Erfahrung da ich schonmal so eine Tabelle mit ähnlich vielen Zeilen hatte mit einer Rechenzeit von 15-20 Minuten.
Daher die Idee die Formeln nur in eine Zeile zu schreiben und dann, wenn sich wirklich etwas geändert hat erst, das ganze Blatt berechnen.
Die Inhalte der Tabellen Filme und Leute stammen aus einer aus dem Internet exportierten CSV Datei, die jedesmal wenn ich sie neu runterlade, die aktuellsten Daten beinhaltet.
Daher kommt die Änderung an den Spalten B, C, E und K.
K ist eine reine Hilfsspalte, da in Spalte F auch händig eingetragene Daten stehen, die nicht in der Tabelle Leute erscheinen, damit diese nicht verloren gehen.
Da die Formeln in Spalte I und J auch von der Sortierreihenfolge abhängen, sortiere ich die Tabelle erstmal neu, bevor ich sie berechne.
Neue Zeilen, die seit dem letzten Ausführen dazu gekommen sind, haben noch keinen Inhalt in den Spalten G bis K (Zeile 12), das wird dann durch das Makro erst berehnet.
Gruß
Christian
Anzeige
AW: Code ohne Scrollen
02.02.2019 14:32:17
Piet
Hallo an alle
ich sehe wieviel Arbeit sich die geschaetzten Kollegen gemacht haben um den Code zufriedenstellend zu optimieren.
@Werner - Hallo Werner, ich habe mir erlaubt deinen Code noch mal zu überarbeiten, und bin sicher das dich das Ergebnis erfreuen wird. So vermeiden wir jede Diskussion wo sich die Zeile mit den Formeln aktuell befindet, und wie man sie zurückladen kann!!
@Christian - mein Vorschlag kommt aus 20 Jahren Excel Praxis, und es bleibt dir überlassen ob du ihn annimmst oder Nicht! - So würde ich es in der Praxis machen, und habe es in all meinen Programmen eingeführt!!
Dies 1. Zeile mit Formeln markiert man sich in einer netten Farbe, gelb, hellgrün, hellblau, wie du willst, und erklaert sie durch die Markierung Offiziell zur - EINGABE ZEILE!
Dann kopiert man diese Daten nach unten, und sortiert den ganzen Datensatz ab Zeilev2 - Da gibt es kein Problem nachher die Formeln in allen Zeilen zu suchen, und zurückkopieren. - Es ist nur ein Vorschlag von mir.
mfg Piet
PS denk bitte daran, es ist der Code von Werner!
Sub Makro3()
Dim loLetzte As Long, ok As Variant
Application.ScreenUpdating = False
'   With Worksheets("Ergebnis")
With Worksheets("Tabelle1")
loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range("L1").Value = ""   'Status löschen
.Range("A1:K1").Copy
.Range("A" & loLetzte).PasteSpecial xlPasteFormats
.Range("A" & loLetzte).PasteSpecial xlPasteValues
.Rows(loLetzte).Interior.ColorIndex = xlNone
Application.CutCopyMode = False
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("C2:C" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range("F2:F" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A2:K" & loLetzte)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
.Range("L1").Value = "kopiert"
.Range("A1").Select
End With
End Sub

Anzeige
AW: Code ohne Scrollen
02.02.2019 14:49:50
Christian
Hallo Piet,
danke für deine Mühe.
die ich hab jetzt mal den Bereich F2:I14 gelöscht, um zu schauen ob nach dem Ausführen des Makros da wieder etwas steht, sprich die Formeln kopiert und berechnet wurden. Leider blieben die Zellen leer.
Gruß
Christian
AW: Code ohne Scrollen
02.02.2019 15:39:51
Piet
Hallo Christian
ich habe deine Datei, bei mir als xlsm, gerade laufen lassen um das zu prüfen. Wenn ich alle Daten ab Zeile 2 lösche kommt trotzdem die Eingabe aus Zeile 1. Anbei eine xlsx Beispieldatei, der Code steht in Tabelle 1 als Text. Kopiere ihn bitte in ein normales Modul.
Als xlsx damit auch Kollegen die Datei öffnen können! - Sollte er trotzdem nicht funktionieren.korrigieren wir ihn.
https://www.herber.de/bbs/user/127373.xlsx
Anzeige
AW: Code ohne Scrollen
02.02.2019 19:36:59
Christian
Hallo Piet,
die Lösung ist zwar von der Idee her super.
Aber schau mal was mit den Formeln in Spalte I und J passiert, wenn Zeile 1 immer diese Zeile bleibt.
Die Ergebnisse sind andere als wenn Zeile 1 mitsortiert würde.
Abgesehen davon, die Formeln werden auch weiterhin nicht in die anderen Zeilen kopiert.
Gruß
Christian
AW: Code ohne Scrollen
31.01.2019 22:52:26
Christian
Hallo Werner,
sorry hatte ich nicht dran gedacht, das muss eine lückenlos gefüllte sein oder? Dann kannst du A bis E nehmen, eine der 5 Spalten.
Nochmal kurz zu dem Punkt, dass ich nach dem Sortieren Inhalte aus der zweiten in die erste Zeile kopiert hab, Zweck des Ganzen war, da durch das Sortieren die Formeln dann in der zweiten statt in der ersten Zeile standen diese wieder in die erste Zeile zu bringen.
Das kann wenn ich das Makro später mal erneut ausführe natürlich auch jede andere Zeile sein, in der die Formeln nach dem Sortieren stehen, das muss nicht zwangsläufig die zweite sein. Genauso wie sie auch in der ersten Zeile stehen bleiben können nach dem Sortieren. Wenn sie in der ersten Zeile stehen bleiben, sollen naürlich auch in diesem Abschnitt des Makros keine Werte eingefügt werden, da sonst die Formeln aus der Tabelle verschwinden.
Gruß
Christian
AW: Code ohne Scrollen
02.02.2019 23:27:31
Piet
Hallo Christian
ich habe deine Nachricht gelesen und einen Test gemacht. - Das Ergebnis könnte dich überraschen, nachdenklich stimmen?
Ich habe den Code von Werner einmal durchlaufen lassen und vorher eine Kopie aller Daten ab Zeile 15 geschrieben. Den Suchlauf für loLetzte Row auf xlDown gesetzt. Dann eine Formel geschrieben um die oberen und unteren Daten zu vergleichen. Schau dir das Ergebnis bitte selber an.
Bei 100 Rifles stand vorher in H 261 + 202, nach dem Sortieren die Zahlen 199 und 141. - Ist das so richtig?
Ich habe da so meine Zweifel und frage dich, denn du weist ja was du damit erreichen willst.
mfg Piet
https://www.herber.de/bbs/user/127378.xlsm
AW: Code ohne Scrollen
03.02.2019 09:53:53
Christian
Hallo Piet,
teilweise ist das gewollt, aber nicht in den Ausmaßen wie in deinem Beispiel.
Wie gesagt, die Tabelle1 ist der Stand der Dinge als ich das Makro zum letzten mal ausgeführt habe + ein paar Zeilen die seitdem dazu gekommen sind. Die Tabelle Filme und Leute sind aus dem Internet exportierte CSV Dateien, die die aktuellen Daten beinhalten, daher die SVERWEIS Formeln in B, C, E und K.
Diese aktualisieren diese Spalten mit den aktuellsten Daten. Sollte sich an einem Datensatz etwas geändert haben, ändern sich natürlich auch die Ergebnisse der Spalten G bis K.
Aber so lange sich an den Daten in C und F nichts ändert, darf sich auch nichts an den DATEDIF Formeln in G und H ändern, schonmal gar nicht durchs sortieren.
Die Formeln in I und J hängen ja von der Sortierreihenfolge ab, dass die sich bei einer anderen Reihenfolge ändern ist so gewollt.
Gruß
Christian
aber mal eine andere Frage
03.02.2019 10:03:07
Christian
warum versuchst du nicht einfach das umzusetzen, was ich von vornerein wollte, ohne die komplette Tabelle umzukrempeln.
Ich wiederhole es mal nochmal.
1. Die Formeln in B1 C1 E1 und K1 bis zum Ende kopieren und ab Zeile 2 die Werte einfügen, damit diese Spalten aktuell sind und die Formeln in Zeile 1 erhalten bleiben.
2. irgendwas in L1 schreiben, um die Spalte mit den Formeln zu markieren.
3. Die Tabelle nach Spalte C nach Alter absteigend, dann nach Spalte F nach Alter aufsteigend sortieren.
4. schaun ob die markierte Zeile immer noch Zeile 1 ist.
4.a. wenn ja weiter zu Punkt 5
4.b. wenn nein, alle Formeln aus der markierten Zeile in Zeile 1 kopieren und Werte in der markierten Zeile einfügen.
5. die Formeln in G1:J1 bis ans Ende bis zum Ende kopieren und ab Zeile 2 die Werte einfügen, damit diese Spalten aktuell sind und die Formeln in Zeile 1 erhalten bleiben.
6. die Markierung in Spalte L entfernen.
Das wars.
Wenn ich das alles händig in dieser Reihenfolge mache, wird alles so berechnet wie es soll.
Gruß
Christian
AW: Code ohne Scrollen
03.02.2019 15:59:37
Piet
Hallo Christian
offenbar habe ich die Aufgabenstellung zuerst ganz falsch verstanden. Dann Sorry ...
Teste bitte mal den unteren Code von Werner, erweitert um die "x" Zelle, um die Formel zurück zu kopieren.
Würde mich freuen wenn diese Variante klappt, dann können wir den Thread Erfolgreich beenden.
mfg Piet
'Code von Werner - um x erweitert von Piet
Sub Makro3()
Dim loLetzte As Long, x As Long
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("B1:C1").Copy .Range("B1:C" & loLetzte)
.Range("B2:C" & loLetzte).Value = .Range("B2:C" & loLetzte).Value
.Range("E1").Copy .Range("E2:E" & loLetzte)
.Range("E2:E" & loLetzte).Value = .Range("E2:E" & loLetzte).Value
.Range("K1").Copy .Range("K1:K" & loLetzte)
.Range("K2:K" & loLetzte).Value = .Range("K2:K" & loLetzte).Value
.Columns("K:K").Copy
.Columns("F:F").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.Range("L1") = "Formel"  'Zeile 1 markieren!!
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("C1:C" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range("F1:F" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:X" & loLetzte)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
'Zeile der Markierung in Spalte l suchen
x = .Cells(Rows.Count, 12).End(xlUp).Row
'Formeln ggf. in Zeile1 zurück kopieren
If x > 1 Then
.Cells(x, 2).Resize(1, 2).Copy .Range("B1")
.Cells(x, 5).Copy .Range("E1")
.Rows(x).Value = .Rows(x).Value
End If
.Range("G1:J1").Copy .Range("G2:J" & loLetzte)
.Range("G2:J" & loLetzte).Value = .Range("G2:J" & loLetzte).Value
.Range("L1") = Empty  'markierung löschen
.Range("E2").Select
End With
End Sub

fange dann mal an zu testen...
04.02.2019 15:39:35
Christian
... schon mal eine Frage vorab
bedeutet x = .Cells(Rows.Count, 12).End(xlUp).Row dass er nur bis Zeile 12 nach der Zeile mit den Formeln sucht?
mir wäre es lieber er sucht in der ganzen Tabelle danach
oder heißt das Spalte 12?
jedenfalls ich teste dann mal und melde mich nachher.
Gruß
Christian
Testergebnis:
04.02.2019 15:50:29
Christian
Hallo Piet,
bleiben die Formeln in Zeile 1 funktioniert es.
bleiben sie nicht da, werden nur die Formeln in B1, C1 und E1 zurück in Zeile 1 kopiert, die Formeln in G1:K1 sind nach dem Ausführen des Makros nicht mehr vorhanden.
Bzw. der Inhalt der Zellen G1:J1 wurde dann am Ende des Makros bis zur letzten Zeile kopiert, da keine Formel mehr vorhanden war.
Gruß
Christian
AW: Testergebnis:
05.02.2019 02:12:26
Piet
Hallo Christian
Sorry, ich habe tatsaechlich die Formeln der letzten Spalten übersehen. Nur der Code Teil in If Then muss geaendert werden!
x = .Cells(Rows.Count, 12).End(xlUp).Row - heisst, es wird die LastZell in Spalte 12 gesucht! - Von ganz unten, letzte Zeile!
mfg Piet
           'Formeln ggf. in Zeile1 zurück kopieren
If x > 1 Then
.Cells(x, 2).Resize(1, 2).Copy .Range("B1")
.Cells(x, 7).Resize(1, 5).Copy .Range("G1")
.Cells(x, 5).Copy .Range("E1")
.Rows(x).Value = .Rows(x).Value
End If

AW: Testergebnis:
05.02.2019 07:38:46
Christian
Hallo Piet,
zwei Dinge funktionieren leider immer noch nicht.
Das Wort Formel wird nur gelöscht, wenn es in L1 steht, nicht jedoch wenn es in einer anderen Zelle steht.
Aber das zweite kann ich mir absolut nicht erklären, das Makro ändert die Sortierreihenfolge bei den Filmen, bei denn Schauspieler ohne Geburtsdatum in der Liste stehen, in der Beispieltabelle stehen immer pro Film die jüngsten Schauspieler zuerst und die ältesten zuletzt.
Hat jeder Schauspieler in einem Film ein Geburtsdatum bleibt das auch so. Hat nicht jeder eins, wird die Reihenfolge umgedreht und der älteste steht zuerst da und der jüngste zuletzt.
Gruß
Christian
AW: Testergebnis:
05.02.2019 13:58:09
Piet
Hallo Christian
ein Fehler ist leicht zu beseitigen, Flüchtigkeitsfehler. Das Löschen von "Formel" in Spalte L
.Cells(x, 12) = Empty 'markierung löschen
Ansonsten habe ich den Code von Werner noch einmal verglichen, Ausser den Copy Befehlen hinter dem Sortieren (weil die Formel in Zeile 2 stand) ist alles identisch, bis auf den letzten Befehl VOR .Range("E2").Select! - Bei Werner steht zum Schluss:
.Range("G1:J1").Copy .Range("G2:J" & loLetzte)
.Range("E2").Select
bei mir kommt noch mal der Befehl:
.Range("G2:J" & loLetzte).Value = .Range("G2:J" & loLetzte).Value
Ich weiss nicht ob der richtig ist? - Kann dieser letzte Befehl die Formeln von G-J in Wert umwandeln den Fehler verursachen?
mfg Piet
AW: Testergebnis:
05.02.2019 15:14:11
Christian
Hallo Piet,
ich denke du hast gesehen, was ich meine, die Sortierreihenfolge dreht sich bei den Filmen, die auch Schauspieler ohne Geburtsdatum haben um.
Aber mit der Frage ob das den Fehler verursacht bin ich überfragt. Ich habe die beiden Zeilen einfach mal ein ' davor gesetzt und geschaut was dann passiert, vorher standen die Leute ohne Datum vor denen mit Datum, jetzt stehen sie dahinter. Die Reihenfolge von jung nach alt bleibt zumindest mal einheitlich.
Aber ob sie jetzt davor oder dahinter stehen ist mir egal, das ändert ja nichts an den Formelergebnissen.
Aber diese beiden Zeilen ausklammern ist ja nicht Sinn der Sache.
Gruß
Christian
AW: Eine leere Formel Zelle ist NICHT Leer!!
05.02.2019 21:05:13
Piet
Hallo Christian
ich glaube ich habe das Geheimnis warum der schön bereinigte Code von Werner in der Praxis doch anders funktioniert hat entdeckt.
Es ist ein Phaenomen über das ich auch schon oft verzweifelt bin - LEERE Formel Zellen sind - NICHT LEER!
Darüber kann man als Programmierer verrückt werden wenn man den Zustand von Zellen abfragt, optisch sieht das sie leer ist, die Bearbeitungsleiste keinen Wert anzeigt! - Und das Makro sagt - Ätsch, für mich ist sie NICHT LEER! - Ihr Wert ist Empty!
Ich glaube du verstehst im Augenblick kein Wort von dem was ich sage.
Dann teste mal bitte diese neue Version, und schau dir den Unterschied zum Werner Makro in Ruhe an.
Werner hat den Formel-Werte üblicherweise über ein Array in Werte umgewandelt. macht man es über Copy & Paste ist bei LEEREN Zellen das Sortier Ergebnis anders. Warum das technisch so ist musst du bitte Microsoft fragen. Ich weis es wirklich Nicht!
mfg Piet
'Code von Werner - um x erweitert von Piet
'** 5.2.2019  Formeln in Werte verwandeln über Copy & Paste, statt Array!!
Sub Makro3()
Dim loLetzte As Long, j As Long, x As Long
Application.ScreenUpdating = False
With Worksheets("Ergebnis")
loLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("B1:C1").Copy .Range("B1:C" & loLetzte)
.Range("B2:C" & loLetzte).Copy
.Range("B2:C" & loLetzte).PasteSpecial xlPasteValues
.Range("E1").Copy .Range("E2:E" & loLetzte)
.Range("E2:E" & loLetzte).Copy
.Range("E2:E" & loLetzte).PasteSpecial xlPasteValues
.Range("K1").Copy .Range("K1:K" & loLetzte)
.Range("K2:K" & loLetzte).Copy
.Range("K2:K" & loLetzte).PasteSpecial xlPasteValues
.Columns("K:K").Copy
.Columns("F:F").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.Range("L1") = "Formel"  'Zeile 1 markieren!!
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("C1:C" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range("F1:F" & loLetzte), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A1:L" & loLetzte)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Zeile der Markierung in Spalte l suchen
x = .Cells(Rows.Count, 12).End(xlUp).Row
'Formeln ggf. in Zeile1 zurück kopieren
If x > 1 Then
.Cells(x, 2).Resize(1, 2).Copy .Range("B1")
.Cells(x, 7).Resize(1, 5).Copy .Range("G1")
.Cells(x, 5).Copy .Range("E1")
.Rows(x).Value = .Rows(x).Value
End If
.Range("G1:J1").Copy .Range("G2:J" & loLetzte)
.Range("G2:J" & loLetzte).Value = .Range("G2:J" & loLetzte).Value
.Cells(x, 12) = Empty 'markierung löschen
.Range("E2").Select
End With
End Sub

AW: Eine leere Formel Zelle ist NICHT Leer!!
06.02.2019 08:25:40
Christian
Hallo Piet,
so auf den ersen Blick scheint es zu funktionieren. Habe mal aktuelle Daten runtergeladen, sodass sich ordentlich was an der Tabelle ändert und soweit ich es sehen kann hat es funktioniert. Das einzige das jetzt nicht geteste wurde, in diesem Test sind die Formeln in Zeile 1 geblieben.
Gruß
Christian
Danke für die viele Mühe!!!!!!!!!!!!!!!!!!!!
AW: Eine leere Formel Zelle ist NICHT Leer!!
05.02.2019 21:13:39
Piet
Nachtrag - für technisch Interessierte Leser!
wie schafft es Piet als alter Mann mit nur Excel 97-2003 Wissen trotzdem solche Fehler aufzuspüren?
Antwort:
Ich habe das Original Makro von Christian durchlaufen lassen und gesehen dass das Sortier Ergebnis wirklich anders war.
Dann suche ich den Code systematisch nach Unterschieden durch, und teste ihn solange, bis ich den Fehler finde.
mfg Piet

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige