MS Access 编译错误:类型不匹配数组或预期的用户定义类型

问题描述 投票:0回答:1

我有以下代码,我不断收到类型不匹配数组错误。我尝试了许多不同的改变,但无法弄清楚。任何帮助将不胜感激

Option Compare Database
Option Explicit

' Helper function to shuffle an array using the Fisher-Yates algorithm
Sub ShuffleArray(ByRef arr() As Variant)
    Dim i As Long, j As Long
    Dim temp As Variant

    For i = UBound(arr) To LBound(arr) + 1 Step -1
        ' Calculate the index to swap with
        j = Int((i - LBound(arr) + 1) * Rnd + LBound(arr))

        ' Swap the elements
        temp = arr(i)
        arr(i) = arr(j)
        arr(j) = temp
    Next i
End Sub
Sub GenerateFixtures()
    ' Declare variables
    Dim db As DAO.Database
    Dim rsTeams As DAO.Recordset
    Dim rsMatch As DAO.Recordset
    Dim leagueID As Long
    Dim league As String
    Dim startDate As Date
    Dim numberOfWeeks As Integer
    Dim currentWeek As Integer
    Dim teamCount As Integer
    Dim TeamIDs() As Long
    Dim teamNames() As String
    Dim i As Integer, j As Integer

    ' Set the league ID for which you want to generate fixtures
    leagueID = 1 ' Change this to the desired league ID

    ' Open the database
    Set db = CurrentDb

    ' Get league details
    Dim leagueSQL As String
    leagueSQL = "SELECT LeagueID, League, StartDate, NumberOfWeeks FROM League WHERE LeagueID = " & leagueID
    Dim rsLeague As DAO.Recordset
    Set rsLeague = db.OpenRecordset(leagueSQL)

    If rsLeague.EOF Then
        MsgBox "League not found!", vbExclamation
        Exit Sub
    End If

    ' Get league details
    leagueID = rsLeague!leagueID
    league = rsLeague!league
    startDate = rsLeague!startDate
    numberOfWeeks = rsLeague!numberOfWeeks

    ' Close the league recordset
    rsLeague.Close

    ' Get team details for the specified league
    Dim teamsSQL As String
    teamsSQL = "SELECT ID, Team FROM Teams WHERE LeagueID = " & leagueID
    Set rsTeams = db.OpenRecordset(teamsSQL)

    ' Initialize arrays to store team IDs and names
    Dim maxTeamCount As Integer
    maxTeamCount = 100 ' Set a maximum count, adjust as needed

    ReDim TeamIDs(1 To maxTeamCount)
    ReDim teamNames(1 To maxTeamCount)

    ' Loop through the recordset
    i = 1
    rsTeams.MoveFirst ' Ensure you start from the first record
    Do While Not rsTeams.EOF
        TeamIDs(i) = rsTeams!ID
        teamNames(i) = rsTeams!Team
        i = i + 1

        ' Exit loop if you reach the maximum count
        If i > maxTeamCount Then
            MsgBox "Exceeded the maximum team count.", vbExclamation
            Exit Do
        End If

        rsTeams.MoveNext
    Loop

    ' Resize arrays to the actual count
    ReDim Preserve TeamIDs(1 To i - 1)
    ReDim Preserve teamNames(1 To i - 1)

    ' Close the teams recordset
    rsTeams.Close

    ' Assign the teamCount variable after TeamIDs is populated
    teamCount = UBound(TeamIDs)


    ' Open the Match recordset for appending new fixtures
    Set rsMatch = db.OpenRecordset("Match", dbOpenDynaset)

   ' Generate fixtures using random pairing
    For currentWeek = 1 To numberOfWeeks
        ' Randomize the order of teams
        ShuffleArray TeamIDs
        ShuffleArray teamNames

        ' Loop through each team and create fixtures
        For i = 1 To teamCount - 1 Step 2
            ' Add a new record to the Match table
            rsMatch.AddNew
            rsMatch!leagueID = leagueID
            rsMatch!league = league
            rsMatch!Week = currentWeek
            rsMatch!MatchDate = startDate + (currentWeek - 1) * 7 ' Assuming matches are weekly
            rsMatch!teamAID = TeamIDs(i)
            rsMatch!TeamA = teamNames(i)
            rsMatch!teamBID = TeamIDs(i + 1)
            rsMatch!TeamB = teamNames(i + 1)
            rsMatch.Update
        Next i
    Next currentWeek

    ' Close the Match recordset
    rsMatch.Close

    ' Display a success message
    MsgBox "Fixtures generated successfully!", vbInformation
End Sub

这是在联赛内安排比赛。每支球队每周应与同一联赛中的另一支球队进行一场比赛。周数(以及因此匹配的周数)取决于 numberofweeks 列中的值。在联赛期间,每支球队只会与另一支球队比赛一次。

vba ms-access fixtures sports-league-scheduling-problem
1个回答
0
投票

代码尝试将数组对象传递给声明的数组变量。这行不通。选项:

  1. 更改代码以声明可以容纳任何内容的变体对象变量。

    Sub ShuffleArray(ByRef arr As Variant)

  2. 不要传递数组对象,而是在模块头中将其声明为 Public,然后两个过程都可以引用该对象变量。

© www.soinside.com 2019 - 2024. All rights reserved.