Makros verbinden
08.05.2025 22:04:41
Siegfried Pütz
habe das mit Paarungen hin bekommen, aus anderer Datei, bestehend aus 2 Makros (siehe Codes).
Das erste Makro soll als Mastermakro fungieren. Das 2. Makro soll als 1. Sub Makro und das dritte Makro als 2. Sub Makro.
Frage dazu:
Wie kann man das bewerkstelligen?
Gruß,
SiggiP
Makro 1 - Mastermakro
' Namen_mischen Makro
'
'
Range("AC38:AD45").Select
ActiveWorkbook.Worksheets("Rd.1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Rd.1").Sort.SortFields.Add Key:=Range("AD38:AD45") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Rd.1").Sort
.SetRange Range("AC38:AD45")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("D4").Select
End Sub1, Sub Makro:
Sub Guppe_a_paaren()
'
' Guppe_a_paaren Makro
Range("A1:A8,a11").Select
Range("A11").Activate
End Sub2. Sub Makro
Option Explicit
Dim MrkTxt As String, MrkTx1 As String, MrkTx2 As String
Dim MAN() As String, HLP() As String, PAR() As String, BER As Range, Asg As Range
Dim i As Long, j As Long, n As Long, p As Long, s As Long, z As Long, mx As Long
Dim TLE As Variant, Hlf As String
Dim mxNr As Long, mxSpT As Long, SpProSpT As Long, mxSp As Long
Sub SpielPaarungen()
On Error GoTo EXT
Application.Volatile
MrkTxt = Application.Selection.AddressLocal
TLE = Split(MrkTxt, ";")
MrkTx1 = Trim(TLE(0))
MrkTx2 = Trim(TLE(1))
Set BER = Range(MrkTx1)
Set Asg = Range(MrkTx2)
z = BER.Rows.Count: s = BER.Columns.Count
If s = 1 And z > 2 Then
n = BER.Count
If BER.Rows.Count Mod 2 = 1 Then
mx = n * (n + 1)
n = n + 1
Else
mx = n * (n - 1)
End If
ReDim MAN(1 To n) As String
ReDim HLP(1 To n) As String
ReDim PAR(1 To mx) As String
If BER.Rows.Count Mod 2 = 1 Then
MAN(1) = "spielfrei"
HLP(1) = "spielfrei"
For i = 2 To n
MAN(i) = BER(i - 1)
HLP(i) = BER(i - 1)
Next i
Else
For i = 1 To n
MAN(i) = BER(i)
HLP(i) = BER(i)
Next i
End If
p = 0
Call ERMPAR
For j = 1 To (n - 2)
Call NEUHLP
Call ERMPAR
Next j
mxSpT = n - 1
SpProSpT = n / 2
mxSp = mxSpT * SpProSpT
For i = 1 To mxSp
Asg(1).Offset(i - 1, 0) = PAR(i * 2 - 1)
Asg(1).Offset(i - 1, 1) = PAR(i * 2)
Next i
Set BER = Nothing
Set Asg = Nothing
Else
MsgBox "#Markierung?" & vbCr & vbCr & _
"1. Markierung: alle Teilnehmer ( nur 1 Spalte )" & vbCr & _
" - dann Taste 'Strg' festhalten - " & vbCr & _
"2. Markierung: für Ausgabe ( 1 Zelle reicht) " & vbCr & _
" - danach Makro starten! - ok? ", _
vbCritical + vbOKOnly, "Spielpaarungen"
End If
End
EXT:
MsgBox "#Markierung?" & vbCr & vbCr & _
"1. Markierung: alle Teilnehmer ( nur 1 Spalte )" & vbCr & _
" - dann Taste 'Strg' festhalten - " & vbCr & _
"2. Markierung: für Ausgabe ( 1 Zelle reicht) " & vbCr & _
" - danach Makro starten! - ok? ", _
vbCritical + vbOKOnly, "Spielpaarungen"
End Sub
'********************************
Private Sub NEUHLP()
Hlf = HLP(n)
For i = n To 3 Step -1
HLP(i) = HLP(i - 1)
Next i
HLP(2) = Hlf
End Sub
Private Sub ERMPAR()
For i = 1 To (n / 2)
p = p + 1
PAR(p) = HLP(i)
p = p + 1
PAR(p) = HLP((n + 1) - i)
Next i
End Sub
Anzeige