Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.
Clever-Excel-Forum › Office-Anwendungen › Excel v
Makro mit Querverweis aus Stammdaten

Thema geschlossen 
Baumstrukturmodus
Makro mit Querverweis aus Stammdaten
dindu Offline
Benutzer
Registriert seit: 15.07.2015
Version(en): 2010
#1
25.07.2015, 13:05
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
Suchen
Antworten Top
dindu Offline
Benutzer
ThreadStarter

Registriert seit: 15.07.2015
Version(en): 2010
#2
25.07.2015, 14:58
Hallo zusammen, für jede konstruktive Hilfe, wäre ich sehr dankbar
Suchen
Antworten Top
Rabe Offline
:-)
Registriert seit: 10.04.2014
Version(en): 2016 + 365
#3
27.07.2015, 11:06
Hi,

(25.07.2015, 13: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
Suchen
Antworten Top
Rabe Offline
:-)
Registriert seit: 10.04.2014
Version(en): 2016 + 365
#4
27.07.2015, 11:14 (Dieser Beitrag wurde zuletzt bearbeitet: 27.07.2015, 11:18 von Rabe.)
(25.07.2015, 14: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!
Suchen
Antworten Top
dindu Offline
Benutzer
ThreadStarter

Registriert seit: 15.07.2015
Version(en): 2010
#5
27.07.2015, 11:28 (Dieser Beitrag wurde zuletzt bearbeitet: 27.07.2015, 13:52 von Rabe.)
(27.07.2015, 11: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
Suchen
Antworten Top
Rabe Offline
:-)
Registriert seit: 10.04.2014
Version(en): 2016 + 365
#6
27.07.2015, 14:08 (Dieser Beitrag wurde zuletzt bearbeitet: 27.07.2015, 14:23 von Rabe.)
Hi,

(27.07.2015, 11: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
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


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