|
Hey,
folgendes:
Ich habe einen VBA Code, der zwei Statistiken von zwei Fußballmannschaften untereinander schreibt, das sieht so aus:
https://gyazo.com/a6f0498487d9ce43b5d1dc6aa9722fc1
Ich möchte die aber nebeneinander, um besser damit kalkulieren zu können..
Das hier ist der VBA Code:
Sub get_team_data()
'''variable for saving workbook name
Dim data_workbook As String
Dim file_test As String
'''Get workbook name
data_workbook = Range("I2").Value
Dim data As Workbook
Dim extractor As Workbook
Dim league_name As Worksheet
Dim data_sheets_count As Integer
'''Set workbooks in variables
Set extractor = ThisWorkbook
Set data = Workbooks.Open(ThisWorkbook.Path & "\" & data_workbook, True, True)
Set league_name = ThisWorkbook.Sheets("league name")
'''Total sheets count in data sheet
data_sheets_count = data.Sheets.Count
'''Activate main sheet
extractor.Activate
'''Set teams sheet for saving team names
Dim league_teams_1 As Worksheet
Dim league_teams_2 As Worksheet
Dim match_sheet As Worksheet
Set league_teams_1 = ThisWorkbook.Sheets("League teams1")
Set league_teams_2 = ThisWorkbook.Sheets("League teams2")
Set match_sheet = ThisWorkbook.Sheets("Match Sheet")
match_sheet.Range("A:ZZ").ClearContents
'''get league names from sheets
Dim league_1 As String
Dim league_2 As String
league_1 = Range("C3").Value
league_2 = Range("F3").Value
'''get teams names from sheets
Dim team_1 As String
Dim team_2 As String
team_1 = Range("C5").Value
team_2 = Range("F5").Value
Dim cell_to_paste As Integer
''' For team 1
'''loop to check league name
For i = 1 To data_sheets_count
If data.Sheets(i).Name = league_1 Then
'''loop to check team name and get data
For x = 1 To data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
If data.Sheets(i).Range("B" & x).Value = team_1 Then
For y = x + 1 To data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
If data.Sheets(i).Range("B" & y).Value <> "" Then
data.Sheets(i).Range("B" & x & ":ZZ" & y - 1).Copy
match_sheet.Activate
match_sheet.Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
cell_to_paste = y - x
y = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
x = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
i = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
ElseIf y = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row Then
data.Sheets(i).Range("B" & x & ":zz" & data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row).Copy
match_sheet.Activate
match_sheet.Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
cell_to_paste = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row - x
y = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
x = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
i = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
End If
Next y
End If
Next x
End If
Next i
''' For team 1
'''loop to check league name
For i = 1 To data_sheets_count
If data.Sheets(i).Name = league_2 Then
'''loop to check team name and get data
For x = 1 To data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
If data.Sheets(i).Range("B" & x).Value = team_2 Then
For y = x + 1 To data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
If data.Sheets(i).Range("B" & y).Value <> "" Then
data.Sheets(i).Range("B" & x & ":ZZ" & y - 1).Copy
match_sheet.Activate
match_sheet.Range("A" & cell_to_paste + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
y = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
x = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
i = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
ElseIf y = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row Then
data.Sheets(i).Range("B" & x & ":zz" & data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row).Copy
match_sheet.Activate
match_sheet.Range("A" & cell_to_paste + 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
y = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
x = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
i = data.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
End If
Next y
End If
Next x
End If
Next i
extractor.Sheets("Options").Activate
End Sub
Was genau muss ich ändern, dass das funktioniert?
Vielen Dank :)
|