Microsoft Excel

Herbers Excel/VBA-Archiv

aufgezeichnetes Makro vereinfachen


Betrifft: aufgezeichnetes Makro vereinfachen von: Christian
Geschrieben am: 31.01.2019 15:49:49

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

  

Betrifft: AW: aufgezeichnetes Makro vereinfachen von: Rudi Maintaire
Geschrieben am: 31.01.2019 15:56:55

Hallo,
lösch erst mal alle ActiveWindow.ScrollRow-Zeilen. Die brauchst du nicht.
Dann sehen wir weiter.

Gruß
Rudi


  

Betrifft: AW: aufgezeichnetes Makro vereinfachen von: Daniel
Geschrieben am: 31.01.2019 16:32:57

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


  

Betrifft: AW: aufgezeichnetes Makro vereinfachen von: UweD
Geschrieben am: 31.01.2019 16:37:31

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


  

Betrifft: AW: aufgezeichnetes Makro vereinfachen von: Christian
Geschrieben am: 31.01.2019 16:54:15

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


  

Betrifft: Code ohne Scrollen von: Christian
Geschrieben am: 31.01.2019 22:11:24

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



  

Betrifft: AW: Code ohne Scrollen von: Werner
Geschrieben am: 31.01.2019 22:41:01

Hallo Christian,

und in welcher Spalte bitte kann die letzte Zeile ermittelt werden, bis wohin immer kopiert werden soll?

Gruß Werner


  

Betrifft: AW: Code ohne Scrollen von: Christian
Geschrieben am: 31.01.2019 22:45:53

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


  

Betrifft: AW: Code ohne Scrollen von: Werner
Geschrieben am: 31.01.2019 22:52:41

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


  

Betrifft: AW: Code ohne Scrollen von: Christian
Geschrieben am: 31.01.2019 23:03:26

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


  

Betrifft: AW: Code ohne Scrollen von: Werner
Geschrieben am: 31.01.2019 23:19:16

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


  

Betrifft: AW: Code ohne Scrollen von: Christian
Geschrieben am: 01.02.2019 07:19:47

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


  

Betrifft: AW: Code ohne Scrollen von: Piet
Geschrieben am: 02.02.2019 14:32:17

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



  

Betrifft: AW: Code ohne Scrollen von: Christian
Geschrieben am: 02.02.2019 14:49:50

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


  

Betrifft: AW: Code ohne Scrollen von: Piet
Geschrieben am: 02.02.2019 15:39:51

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


  

Betrifft: AW: Code ohne Scrollen von: Christian
Geschrieben am: 02.02.2019 19:36:59

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


  

Betrifft: AW: Code ohne Scrollen von: Christian
Geschrieben am: 31.01.2019 22:52:26

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


  

Betrifft: AW: Code ohne Scrollen von: Piet
Geschrieben am: 02.02.2019 23:27:31

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


  

Betrifft: AW: Code ohne Scrollen von: Christian
Geschrieben am: 03.02.2019 09:53:53

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


  

Betrifft: aber mal eine andere Frage von: Christian
Geschrieben am: 03.02.2019 10:03:07

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


  

Betrifft: AW: Code ohne Scrollen von: Piet
Geschrieben am: 03.02.2019 15:59:37

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



  

Betrifft: fange dann mal an zu testen... von: Christian
Geschrieben am: 04.02.2019 15:39:35

... 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


  

Betrifft: Testergebnis: von: Christian
Geschrieben am: 04.02.2019 15:50:29

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


  

Betrifft: AW: Testergebnis: von: Piet
Geschrieben am: 05.02.2019 02:12:26

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



  

Betrifft: AW: Testergebnis: von: Christian
Geschrieben am: 05.02.2019 07:38:46

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


  

Betrifft: AW: Testergebnis: von: Piet
Geschrieben am: 05.02.2019 13:58:09

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


  

Betrifft: AW: Testergebnis: von: Christian
Geschrieben am: 05.02.2019 15:14:11

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


  

Betrifft: AW: Eine leere Formel Zelle ist NICHT Leer!! von: Piet
Geschrieben am: 05.02.2019 21:05:13

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



  

Betrifft: AW: Eine leere Formel Zelle ist NICHT Leer!! von: Christian
Geschrieben am: 06.02.2019 08:25:40

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!!!!!!!!!!!!!!!!!!!!


  

Betrifft: AW: Eine leere Formel Zelle ist NICHT Leer!! von: Piet
Geschrieben am: 05.02.2019 21:13:39

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


Beiträge aus dem Excel-Forum zum Thema "aufgezeichnetes Makro vereinfachen"