Makro mit Querverweis aus Stammdaten
#1
Das Ergebnis in Zelle"K2" = die Differenz Home & Away 
hierfür der Makro soll die Manschaft vor der Trennung (-) [ in diesem Beipiel "Aldosivi" in Spalte "B" suchen desen Wert aus der Spalte "C" in die Zelle "K2" kopieren , das gleiche soll er für die Manschaft nach der Trennung (-)[ in diesem Beipiel "Temperley " und in der Zelle "K2" , beide Werte sollen subtrahiert werden , die Differenz heisst "MR" , er soll dann im Tab "MR" unter der Spalte K nach diesem Wert suchen ( in unserem Beispiel MR= -7 ) danach soll er die 3 Werte aus Spalte " L,M,N " in den Tab " GD-Table" in den Spalten " N,O,P" für den entsprechenden MR-Wert kopieren und mit FArbformattierung gröser GRÜN, mittle GELB, klein ROT .
Wenn möcglich diesen Makro in der angehängten Datei mit einem Button versehen.
Vielen Dank im Voraus für jede konstruktive Hilfe. 

PS: ich habe alle oben beschriebene Schritte händig in der angehängten Datei durchgeführt
Top
#2
Hallo zusammen, für jede konstruktive Hilfe, wäre ich sehr dankbar
Top
#3
Hi,

(25.07.2015, 14:05)dindu schrieb: PS: ich habe alle oben beschriebene Schritte händig in der angehängten Datei durchgeführt

welches Makro meinst Du?
Sub CHRIS_DRAW_IMPORT()
' 
' CHRIS_DRAW_IMPORT Macro 
' CHRIS DRWA HOME_DRAW AND AWAY_DRAW 
' 

' 
    Columns("R:Z").Select
    Selection.Delete Shift:=xlToLeft
    Columns("S:AM").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.LargeScroll ToRight:=-1
    Columns("O:R").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("J2:M39").Select
    Selection.ClearContents
    Range("P2:R2").Select
    Selection.Cut
    Range("J2").Select
    ActiveSheet.Paste
    Range("P5").Select
    Selection.Cut
    Range("M2").Select
    ActiveSheet.Paste
    Range("P6:R6").Select
    Selection.Cut
    Range("J3").Select
    ActiveSheet.Paste
    Range("P9").Select
    Selection.Cut
    Range("M3").Select
    ActiveSheet.Paste
    Range("P10:R10").Select
    Selection.Cut
    Range("J4").Select
    ActiveSheet.Paste
    Range("P13").Select
    Selection.Cut
    Range("M4").Select
    ActiveSheet.Paste
    Range("P14:R14").Select
    Selection.Cut
    Range("J5").Select
    ActiveSheet.Paste
    Range("P17").Select
    Selection.Cut
    Range("M5").Select
    ActiveSheet.Paste
    Range("P18:R18").Select
    Selection.Cut
    Range("J6").Select
    ActiveSheet.Paste
    Range("P21").Select
    Selection.Cut
    Range("M6").Select
    ActiveSheet.Paste
    Range("P22:R22").Select
    Selection.Cut
    Range("J7").Select
    ActiveSheet.Paste
    Range("P25").Select
    Selection.Cut
    Range("M7").Select
    ActiveSheet.Paste
    Range("P26:R26").Select
    Selection.Cut
    Range("J8").Select
    ActiveSheet.Paste
    Range("P29").Select
    Selection.Cut
    Range("M8").Select
    ActiveSheet.Paste
    Range("P30:R30").Select
    Selection.Cut
    Range("J9").Select
    ActiveSheet.Paste
    Range("P33").Select
    Selection.Cut
    Range("M9").Select
    ActiveSheet.Paste
    Range("P34:R34").Select
    Selection.Cut
    Range("J10").Select
    ActiveSheet.Paste
    Range("P37").Select
    Selection.Cut
    Range("M10").Select
    ActiveSheet.Paste
    Range("P38:R38").Select
    Selection.Cut
    Range("J11").Select
    ActiveSheet.Paste
    Range("P41").Select
    Selection.Cut
    Range("M11").Select
    ActiveSheet.Paste
    Range("P42:R42").Select
    Selection.Cut
    Range("J12").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=6
    Range("P45").Select
    Selection.Cut
    Range("M12").Select
    ActiveSheet.Paste
    Range("P46:R46").Select
    Selection.Cut
    Range("J13").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=6
    Range("P49").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-6
    Range("M13").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=9
    Range("P50:R50").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-9
    Range("J14").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=9
    Range("P53").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-9
    Range("M14").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=15
    Range("P54:R54").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-9
    Range("J15").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=12
    Range("P57").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-18
    Range("M15").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=15
    Range("P58:R58").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-12
    Range("J16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=15
    Range("P61").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-12
    Range("M16").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=15
    Range("P62:R62").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-24
    Range("J17").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=24
    Range("P65").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-27
    Range("M17").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=27
    Range("P66:R66").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-18
    Range("J18").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=30
    Range("P69").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-27
    Range("M18").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=27
    Range("P70:R70").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-24
    Range("J19").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=27
    Range("P73").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-30
    Range("M19").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=39
    Range("P74:R74").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-39
    Range("J20").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=33
    Range("P77").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-39
    Range("M20").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=42
    Range("P78:R78").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-39
    Range("J21").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=42
    Range("P81").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-42
    Range("M21").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=42
    Range("P82:R82").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-45
    Range("J22").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=51
    Range("P85").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-42
    Range("M22").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=45
    Range("P86:R86").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-51
    Range("J23").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=42
    Range("P89").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-45
    Range("M23").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=54
    Range("P90:R90").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-54
    Range("J24").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=57
    Range("P93").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-57
    Range("M24").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=69
    Range("P94:R94").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-57
    Range("J25").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=51
    Range("P97").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-54
    Range("M25").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=57
    Range("P98:R98").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-54
    Range("J26").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=54
    Range("P101").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-60
    Range("M26").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=63
    Range("P102:R102").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-57
    Range("J27").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=63
    Range("P105").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-63
    Range("M27").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=66
    Range("P106:R106").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-75
    Range("J28").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=75
    Range("P109").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-69
    Range("M28").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=75
    Range("P110:R110").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-75
    Range("J29").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=72
    Range("P113").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-75
    Range("M29").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=81
    Range("P114:R114").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-69
    Range("J30").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=72
    Range("P117").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-81
    Range("M30").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=75
    Range("P118:R118").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-63
    Range("J31").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=60
    Range("P121").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-69
    Range("M31").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-54
    Columns("P:R").Select
    Selection.ClearContents
    Sheets("fixture template").Select
    Columns("O:O").Select
    Selection.Copy
    Sheets("CHRIS-DRAW").Select
    Range("H1:H16").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Sheets("fixture template").Select
    Columns("O:O").Select
    Selection.Copy
    Sheets("CHRIS-DRAW").Select
    Range("H1").Select
    ActiveWindow.SmallScroll Down:=-3
    ActiveSheet.Paste
End Sub


VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel

Code erstellt und getestet in Office 15


oder

Sub PREDICTIONS_BASED_ON_LAST_4_MATCHS()
' 
' PREDICTIONS_BASED_ON_LAST_4_MATCHS Macro 
' PREDICTIONS_BASED_ON_LAST_4_MATCHS 
' 

' 
    Range("A2:A34").Select
    Selection.Delete Shift:=xlToLeft
    Range("L3:L34").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
    Columns("A:A").EntireColumn.AutoFit
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("L:U").Select
    Columns("L:U").EntireColumn.AutoFit
    Range("M1").Select
    Selection.Cut
    Range("L1").Select
    ActiveSheet.Paste
    Columns("N:N").ColumnWidth = 6
    Columns("O:O").ColumnWidth = 5.43
    Columns("P:P").ColumnWidth = 8
    Columns("Q:Q").ColumnWidth = 4.71
    Columns("R:R").ColumnWidth = 5.86
    Columns("S:S").ColumnWidth = 6.57
    Columns("U:U").ColumnWidth = 6.71
    Range("N2:U2").Select
    Range("U2").Activate
    Selection.Cut
    Range("M2").Select
    ActiveSheet.Paste
    Range("X6").Select
    Columns("Q:Q").ColumnWidth = 8
    Columns("R:R").ColumnWidth = 7.86
    Columns("M:M").ColumnWidth = 13.43
    Range("L2:L32").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("L:L").EntireColumn.AutoFit
    Columns("C:E").Select
    Selection.Delete Shift:=xlToLeft
    Columns("E:F").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:M").Select
    Selection.Delete Shift:=xlToLeft
    Range("A33").Select
    ActiveCell.FormulaR1C1 = "OVERALL GOALS"
    Range("A34").Select
    ActiveCell.FormulaR1C1 = "AVERAGE GOALS"
    Range("B33").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-30]C:R[-1]C)"
    Range("C33").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-30]C:R[-1]C)"
    Range("D33").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-30]C:R[-1]C)"
    Range("A33:F34").Select
    Selection.Copy
    Range("G33").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "ATTACK"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "DEFENSE"
    Columns("E:E").Select
    Columns("E:E").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Range("E2:F33").Select
    Selection.Copy
    Range("K2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("C34").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C/R[-1]C[-1]"
    Range("C34").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C/R33C2"
    Range("D34").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C/R[-1]C[-2]"
    Range("D34").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C/R33C2"
    Range("I34").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C/R[-1]C[-1]"
    Range("I34").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C/R33C8"
    Range("J34").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C/R[-1]C[-2]"
    Range("J34").Select
    ActiveCell.FormulaR1C1 = "=R[-1]C/R33C8"
    Range("J35").Select
    Columns("K:K").ColumnWidth = 9.71
    Columns("L:L").ColumnWidth = 10.29
    Columns("F:F").ColumnWidth = 11.43
    Columns("E:E").ColumnWidth = 9.86
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/R[31]C[-2]"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/R[31]C[-2]"
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/R34C3"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/R34C4"
    Range("E3").Select
    Selection.AutoFill Destination:=Range("E3:E32"), Type:=xlFillDefault
    Range("E3:E32").Select
    Range("F3").Select
    Selection.AutoFill Destination:=Range("F3:F32"), Type:=xlFillDefault
    Range("F3:F32").Select
    Range("E3:F32").Select
    Selection.Copy
    Range("K3").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("E2:F32").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("K2:L32").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A1").Select
End Sub


VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel

Code erstellt und getestet in Office 15


oder

Sub Scores_Import()
' 
' Scores_Import Macro 
' 

' 
    Columns("T:W").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("T:W").EntireColumn.AutoFit
    Columns("V:W").Select
    Selection.Replace What:="()", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="()", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    ActiveCell.Replace What:="()", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="( )", Replacement:="  ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("V1").Select
    ActiveWindow.SmallScroll Down:=-3
    Range("V1:W1").Select
    Selection.Copy
    Range("M4:M6").Select
    Range("V1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("M4:M6").Select
    ActiveSheet.Paste
    Range("W1").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("N4:N6").Select
    ActiveSheet.Paste
    Range("V2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("M13:M15").Select
    ActiveSheet.Paste
    Range("W2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("N13:N15").Select
    ActiveSheet.Paste
    Range("V3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("M22:M24").Select
    ActiveSheet.Paste
    Range("W3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("N22:N24").Select
    ActiveSheet.Paste
    Range("V4").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=9
    Range("M31:M33").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-12
    Range("W4").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=9
    Range("N31:N33").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-15
    Range("V5").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=15
    Range("M40:M42").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-30
    Range("W5").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=18
    Range("N40:N42").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-24
    Range("V6").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=24
    Range("M49:M51").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-39
    Range("W6").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=24
    Range("N49:N51").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-42
    Range("V7").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=36
    Range("M58:M60").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-42
    Range("W7").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=39
    Range("N58:N60").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-54
    Range("V8").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=57
    Range("M67:M69").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-63
    Range("W8").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=48
    Range("N67:N69").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-60
    Range("V9").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=57
    Range("M76:M78").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-54
    Range("W9").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=57
    Range("N76:N78").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-60
    Range("V10").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=66
    Range("M85:M87").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-69
    Range("W10").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=63
    Range("N85:N87").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-72
    Range("V11").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=72
    Range("M94:M96").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-81
    Range("W11").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=87
    Range("N94:N96").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-87
    Range("V12").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=84
    Range("M103:M105").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-84
    Range("W12").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=84
    Range("N103:N105").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-87
    Range("V13").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=102
    Range("M112:M114").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-108
    Range("W13").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=99
    Range("N112:N114").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-105
    Range("V14").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=108
    Range("M121:M123").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-108
    Range("W14").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=105
    Range("N121:N123").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-108
    Range("V15").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=111
    Range("M130:M132").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-105
    Range("W15").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=105
    Range("N130:N132").Select
    ActiveSheet.Paste
    ActiveWindow.ScrollRow = 112
    ActiveWindow.ScrollRow = 111
    ActiveWindow.ScrollRow = 110
    ActiveWindow.ScrollRow = 109
    ActiveWindow.ScrollRow = 108
    ActiveWindow.ScrollRow = 107
    ActiveWindow.ScrollRow = 106
    ActiveWindow.ScrollRow = 105
    ActiveWindow.ScrollRow = 104
    ActiveWindow.ScrollRow = 103
    ActiveWindow.ScrollRow = 102
    ActiveWindow.ScrollRow = 100
    ActiveWindow.ScrollRow = 99
    ActiveWindow.ScrollRow = 98
    ActiveWindow.ScrollRow = 97
    ActiveWindow.ScrollRow = 96
    ActiveWindow.ScrollRow = 95
    ActiveWindow.ScrollRow = 94
    ActiveWindow.ScrollRow = 93
    ActiveWindow.ScrollRow = 92
    ActiveWindow.ScrollRow = 91
    ActiveWindow.ScrollRow = 90
    ActiveWindow.ScrollRow = 89
    ActiveWindow.ScrollRow = 88
    ActiveWindow.ScrollRow = 87
    ActiveWindow.ScrollRow = 86
    ActiveWindow.ScrollRow = 85
    ActiveWindow.ScrollRow = 84
    ActiveWindow.ScrollRow = 83
    ActiveWindow.ScrollRow = 82
    ActiveWindow.ScrollRow = 81
    ActiveWindow.ScrollRow = 80
    ActiveWindow.ScrollRow = 79
    ActiveWindow.ScrollRow = 78
    ActiveWindow.ScrollRow = 77
    ActiveWindow.ScrollRow = 75
    ActiveWindow.ScrollRow = 74
    ActiveWindow.ScrollRow = 72
    ActiveWindow.ScrollRow = 71
    ActiveWindow.ScrollRow = 69
    ActiveWindow.ScrollRow = 68
    ActiveWindow.ScrollRow = 67
    ActiveWindow.ScrollRow = 66
    ActiveWindow.ScrollRow = 65
    ActiveWindow.ScrollRow = 64
    ActiveWindow.ScrollRow = 63
    ActiveWindow.ScrollRow = 62
    ActiveWindow.ScrollRow = 61
    ActiveWindow.ScrollRow = 60
    ActiveWindow.ScrollRow = 58
    ActiveWindow.ScrollRow = 56
    ActiveWindow.ScrollRow = 55
    ActiveWindow.ScrollRow = 54
    ActiveWindow.ScrollRow = 53
    ActiveWindow.ScrollRow = 52
    ActiveWindow.ScrollRow = 51
    ActiveWindow.ScrollRow = 50
    ActiveWindow.ScrollRow = 49
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 47
    ActiveWindow.ScrollRow = 46
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 44
    ActiveWindow.ScrollRow = 43
    ActiveWindow.ScrollRow = 42
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 40
    ActiveWindow.ScrollRow = 39
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 36
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 33
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 31
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 29
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 24
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 22
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
End Sub


VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel

Code erstellt und getestet in Office 15

[-] Folgende(r) 1 Nutzer sagt Danke an Rabe für diesen Beitrag:
  • dindu
Top
#4
(25.07.2015, 15:58)dindu schrieb: Hallo zusammen, für jede konstruktive Hilfe, wäre ich sehr dankbar

als Tipp, damit die Codes kürzer werden:

aus    
Code:
   Range("E3").Select
   ActiveCell.FormulaR1C1 = "=RC[-2]/R[31]C[-2]"
machst Du:
Code:
   Range("E3").FormulaR1C1 = "=RC[-2]/R[31]C[-2]"

Aus
Code:
   Range("P113").Select
   Selection.Cut
   ActiveWindow.SmallScroll Down:=-75
   Range("M29").Select
   ActiveSheet.Paste
machst Du:
Code:
   Range("P113").Cut
   Range("M29").Paste

Aus:
Code:
   Range("P29").Select
   Selection.Cut
   Range("M8").Select
   ActiveSheet.Paste
machst Du:
Code:
   Range("P29").Cut
   Range("M8").Paste

Aus:
Code:
   Columns("O:R").Select
   With Selection
machst Du:
Code:
   With Columns("O:R")

Aus:
Code:
   Columns("P:R").Select
   Selection.ClearContents
   Sheets("fixture template").Select
   Columns("O:O").Select
   Selection.Copy
machst Du
Code:
   Columns("P:R").ClearContents
   Sheets("fixture template").Columns("O:O").Copy

Das:
Code:
   ActiveWindow.ScrollRow = 11
löschen!
Top
#5
(27.07.2015, 12:06)Rabe schrieb: welches Makro meinst Du?

Hallo Ralf, erstmal danke für die Antwort, ich habe wenige Excelkenntnisse, ich werde es nicht schaffen  , diese bestehende Makros wie (CHRIS_DRAW_IMPORT Macro ..etc last 4 matchs ..etc )  bestehen schon und laufen auch und haben mit meinem neuen Vorhaben nichts zu tun. es wäre nett wenn Du mir ein Button erstellst dahinter verbirgt sich das Makro das die beschriebenen Schritte ausführt, vielen Dank
Top
#6
Hi,

(27.07.2015, 12:28)dindu schrieb: diese bestehende Makros wie (CHRIS_DRAW_IMPORT Macro ..etc last 4 matchs ..etc )  bestehen schon und laufen auch und haben mit meinem neuen Vorhaben nichts zu tun. es wäre nett wenn Du mir ein Button erstellst dahinter verbirgt sich das Makro das die beschriebenen Schritte ausführt, vielen Dank

Also alle drei Makros haben mit der eigentlichen Frage nichts zu tun und Du hast kein Makro, das die beschriebenen Schritte ausführt?
Ansonsten brauchen wir den Namen.

Wenn es tatsächlich so ist, dann mußt Du es aufzeichnen:
Makro-Aufzeichnung starten, alle Schritte manuell durchführen, Aufzeichnung stoppen, Code hier veröffentlichen.

Dann können wir ihn verkürzen und verallgemeinern.



Zu den bestehenden Makros:
Ich habe Dir ja schon gezeigt, was Du alles an Deinem Code vereinfachen kannst, das solltest Du machen.
Du glaubst doch nicht ernsthaft, daß ich mich hinsetze und Deine 878 Zeilen Code durcharbeite?

Hier der verkürzte Code des 1. Makros, schau mal, ob das noch dasselbe macht:
Sub CHRIS_DRAW_IMPORT()
   '
   ' CHRIS_DRAW_IMPORT Macro
   ' CHRIS DRWA HOME_DRAW AND AWAY_DRAW
   '
   
   '
   Columns("R:Z").Delete Shift:=xlToLeft
   Columns("S:AM").Delete Shift:=xlToLeft
   ActiveWindow.LargeScroll ToRight:=-1
   
   With Columns("O:R")
       .HorizontalAlignment = xlGeneral
       .VerticalAlignment = xlBottom
       .WrapText = False
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   
   Range("J2:M39").ClearContents
   
   Range("P2:R2").Cut Range("J2")
   Range("P5").Cut Range("M2")
   Range("P6:R6").Cut Range("J3")
   Range("P9").Cut Range("M3")
   Range("P10:R10").Cut Range("J4")
   Range("P13").Cut Range("M4")
   Range("P14:R14").Cut Range("J5")
   Range("P17").Cut Range("M5")
   Range("P18:R18").Cut Range("J6")
   Range("P21").Cut Range("M6")
   Range("P22:R22").Cut Range("J7")
   Range("P25").Cut Range("M7")
   Range("P26:R26").Cut Range("J8")
   Range("P29").Cut Range("M8")
   Range("P30:R30").Cut Range("J9")
   Range("P33").Cut Range("M9")
   Range("P34:R34").Cut Range("J10")
   Range("P37").Cut Range("M10")
   Range("P38:R38").Cut Range("J11")
   Range("P41").Cut Range("M11")
   Range("P42:R42").Cut Range("J12")
   Range("P45").Cut Range("M12")
   Range("P46:R46").Cut Range("J13")
   Range("P49").Cut Range("M13")
   Range("P50:R50").Cut Range("J14")
   Range("P53").Cut Range("M14")
   Range("P54:R54").Cut Range("J15")
   Range("P57").Cut Range("M15")
   Range("P58:R58").Cut Range("J16")
   Range("P61").Cut Range("M16")
   Range("P62:R62").Cut Range("J17")
   Range("P65").Cut Range("M17")
   Range("P66:R66").Cut Range("J18")
   Range("P69").Cut Range("M18")
   Range("P70:R70").Cut Range("J19")
   Range("P73").Cut Range("M19")
   Range("P74:R74").Cut Range("J20")
   Range("P77").Cut Range("M20")
   Range("P78:R78").Cut Range("J21")
   Range("P81").Cut Range("M21")
   Range("P82:R82").Cut Range("J22")
   Range("P85").Cut Range("M22")
   Range("P86:R86").Cut Range("J23")
   Range("P89").Cut Range("M23")
   Range("P90:R90").Cut Range("J24")
   Range("P93").Cut Range("M24")
   Range("P94:R94").Cut Range("J25")
   Range("P97").Cut Range("M25")
   Range("P98:R98").Cut Range("J26")
   Range("P101").Cut Range("M26")
   Range("P102:R102").Cut Range("J27")
   Range("P105").Cut Range("M27")
   Range("P106:R106").Cut Range("J28")
   Range("P109").Cut Range("M28")
   Range("P110:R110").Cut Range("J29")
   Range("P113").Cut Range("M29")
   Range("P114:R114").Cut Range("J30")
   Range("P117").Cut Range("M30")
   Range("P118:R118").Cut Range("J31")
   Range("P121").Cut Range("M31")
   
   Columns("P:R").ClearContents
   '    Sheets("fixture template").Columns("O:O").Copy
   '    Sheets("CHRIS-DRAW").Range("H1:H16").ClearContents
   Sheets("fixture template").Columns("O:O").Copy Sheets("CHRIS-DRAW").Range("H1")
End Sub


VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel

Code erstellt und getestet in Office 15

Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste