宏 - 下标超出范围 [英] Macro - Subscript out of range
问题描述
您好，
我是论坛的新手，但想知道是否有人能够慷慨地帮助我。 我有一个宏，我用于更多的列，而不是它的设计目的。 它在我身上扯了大约30，在22以上不能正常工作。
我认为只会改变一些数字，但事实证明它比我最初开始时更难。 任何人都可以帮忙吗？
I'm new to the forum but was wondering if someone would be gracious enough to help me. I have a macro that I'm using for more columns than it was designed to do. It craps out on me anything about 30 and doesn't work correctly above 22. I would think that it would just be a few numbers to change but it is proving more difficult than I originally started. Can anyone help?
'运行变量
Dim strRun（ 1至30）As String * 3 '运行可用
Dim intTotal（1 To 30）As Integer '运行¥b $ b Dim intTaken（1 To 30）As Integer "截取
尺寸sngRunTime（1〜30）作为单                 '运行时间
'RUN VARIABLES
Dim strRun(1 To 30) As String * 3 'Runs available
Dim intTotal(1 To 30) As Integer 'Runs
Dim intTaken(1 To 30) As Integer 'Taken
Dim sngRunTime(1 To 30) As Single 'Run Time
'DRIVER VARIABLES
Dim intDriver（1到100,1到30）As Integer '驱动程序首选项
Dim strDriver（1到100）As String * 25 '姓名
Dim blnOut（1 To 100）As Boolean '司机进/出
Dim strDsrRun（1 To 100）As String * 3 '运行名称
Dim sngDsrTime（1到100）单身 'DSR的可用时间
'DRIVER VARIABLES
Dim intDriver(1 To 100, 1 To 30) As Integer 'Driver Preferences
Dim strDriver(1 To 100) As String * 25 'Name
Dim blnOut(1 To 100) As Boolean 'Driver in or out
Dim strDsrRun(1 To 100) As String * 3 'Run Name
Dim sngDsrTime(1 To 100) As Single 'DSR's Time Available
Dim strProblems As String        "与数据输入
尺寸intSum作为整数&NBSP问题;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; '首选项总和<< 1 + 2 + 3 ...>>
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;
'这将用于检查JSP的准确性。
Dim strProblems As String 'Problems with data entry
Dim intSum As Integer 'The Sum of the Preferences <<1+2+3...>>
'This will be used to check JSP accuracy.
Dim intTtlRoutes As Integer &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; "
尺寸intTtlDrivers作为字符串 一共路线;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP; "总驱动程序
Dim intTtlRoutes As Integer 'Total Routes
Dim intTtlDrivers As String 'Total Drivers
昏暗strCol作为字符串&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; "列选择
尺寸intCol作为整数&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP; "列选择
尺寸intRow作为整数&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP; "行选择
尺寸strCell作为字符串&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP; '小区选择
Dim strCol As String 'Column selection
Dim intCol As Integer 'Column selection
Dim intRow As Integer 'Row selection
Dim strCell As String 'Cell selection
'*********************************** ********************************** *
'******* ************************************************** ************
$
Sub cmdCalc_Click（）
Dim intRepeat As Integer
Dim blnDone As Boolean
Dim intY As Integer
Dim strSicOut As String * 3
ActiveSheet.Unprotect
Application.ScreenUpdating = False
intRepeat = 0
blnDone = False
Do until blnDone = True
"所有路线列表中的零点数"是
intRow = 5
对于intIndex = 71 To（71 + intTtlRoutes - 1）
如果intIndex< = 90然后
范围（Chr（intIndex）& intRow）。选择
否则b $ b 范围（" A"&安培; CHR（intIndex - 26）及intRow）。选择
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;结束如果
ActiveCell.FormulaR1C1 = 0
下一个intIndex
ReadData' ******************** *
如果strProblems =""然后&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; '********开始，如果************
;&NBSP; '清空时间短'是
范围（" A12："&安培;" A"及（11个+ intTtlDrivers））选择
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP。 &NBSP;&NBSP; Selection.ClearContents
'检查外出的DSR，保存他们的路线
对于intY = 1到intTtlDrivers '记下司机列表
范围（"F"&（intY + 11））。选择 'DSR输出了吗？是
'如果司机外出，他们会被跳过并且他们的路线需要存储
;&NBSP;&NBSP;如果UCase（ActiveCell.Value）="Y"，则然后是
范围（"E"&（intY + 11））。选择
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; strSicOut = ActiveCell.Value
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ; strSicOut =用Ucase（strSicOut）
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP; '查找路线
intRow = 3
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;对于intIndex = 71 To（71 + intTtlRoutes - 1）
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;范围（CHR（intIndex）及intRow）。选择
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;如果ActiveCell.Value = strSicOut然后
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; intTaken（intIndex - 70）= intTaken（intIndex - 70）+ 1"删除从总路线
&NBSP路线;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;结束如果是
下一个intIndex
结束如果
下一个内容
AssignRoutes&NBSP;&NBSP;&NBSP; '******************** *¥b $ b end如果&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP; '********结束如果************
intRepeat = intRepeat + 1
如果（intRepeat = 3）或（strProblems<>""）然后
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; blnDone = True
结束如果是
循环
ShowResults&NBSP;&NBSP;&NBSP;&NBSP; '******************** *
ActiveSheet.Protect DrawingObjects：= True，Contents：= True，Scenarios：= True
AssignProg&NBSP;&NBSP;&NBSP;&NBSP; '********************
'*********************************************************************
'*********************************************************************
Sub cmdCalc_Click()
Dim intRepeat As Integer
Dim blnDone As Boolean
Dim intY As Integer
Dim strSicOut As String * 3
ActiveSheet.Unprotect
Application.ScreenUpdating = False
intRepeat = 0
blnDone = False
Do Until blnDone = True
'Zeros accross the list of Routes Taken
intRow = 5
For intIndex = 71 To (71 + intTtlRoutes - 1)
If intIndex <= 90 Then
Range(Chr(intIndex) & intRow).Select
Else
Range("A" & Chr(intIndex - 26) & intRow).Select
End If
ActiveCell.FormulaR1C1 = 0
Next intIndex
ReadData '********************
If strProblems = "" Then '********begin if************
'Clear Time Short's
Range("A12:" & "A" & (11 + intTtlDrivers)).Select
Selection.ClearContents
'Check for DSRs who are out, save their routes
For intY = 1 To intTtlDrivers 'Goes down the list of drivers
Range("F" & (intY + 11)).Select 'Is the DSR Out?
'If the driver is out, they get skipped and their route needs to be stored
If UCase(ActiveCell.Value) = "Y" Then
Range("E" & (intY + 11)).Select
strSicOut = ActiveCell.Value
strSicOut = UCase(strSicOut)
'Find Route
intRow = 3
For intIndex = 71 To (71 + intTtlRoutes - 1)
Range(Chr(intIndex) & intRow).Select
If ActiveCell.Value = strSicOut Then
intTaken(intIndex - 70) = intTaken(intIndex - 70) + 1 'Remove route from Total Routes
End If
Next intIndex
End If
Next intY
AssignRoutes '********************
End If '********end if************
intRepeat = intRepeat + 1
If (intRepeat = 3) Or (strProblems <> "") Then
blnDone = True
End If
Loop
ShowResults '********************
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
AssignProg '********************
表格（"Linehaul"）。选择
如果strProblems<> ""然后
MsgBox（strProblems）
MsgBox（"请更正作业选择并重新计算。"）
结束
结束如果是
Application.ScreenUpdating = True
strProblems =""
MsgBox（"Bid Sheet Updated。"）
Sheets("Linehaul").Select
If strProblems <> "" Then
MsgBox (strProblems)
MsgBox ("Please correct Job Selections and re-Calculate.")
End
End If
Application.ScreenUpdating = True
strProblems = ""
MsgBox ("Bid Sheet Updated.")
End Sub
'************** ************************************************** *****
$
'************************************ **********************************
'阅读¥
'
Private Sub ReadData（）
GetDriversRoutes&NBSP;&NBSP;&NBSP; "电子表格中计算的总驾驶员和总路线数"为
ReadRouteInfo&NBSP;&NBSP; '将运行，已分配的总运行数和数量放入阵列中$
JSPCheckEmptys
JSPCheckSum
如果strProblems =""然后&NBSP;&NBSP;&NBSP; '没有问题，因为这是一个问题。
ReadDriverInfo&NBSP; '将作业选择放入阵列中$
结束如果
结束子
私人子GetDriversRoutes（）
范围（"H1"）。选择
intTtlRoutes = ActiveCell.Value
范围（"E1"）。选择
intTtlDrivers = ActiveCell.Value
End Sub
Private Sub ReadRouteInfo（）
'*********************************************************************
'*********************************************************************
'READ
'
Private Sub ReadData()
GetDriversRoutes 'Total Drivers and Total Routes counted on the spread sheet
ReadRouteInfo 'Put the Runs, The total Runs assigned, and Number taken into an array
JSPCheckEmptys
JSPCheckSum
If strProblems = "" Then 'No problems with the JSP
ReadDriverInfo 'Put the Job Selection into an array
End If
End Sub
Private Sub GetDriversRoutes()
Range("H1").Select
intTtlRoutes = ActiveCell.Value
Range("E1").Select
intTtlDrivers = ActiveCell.Value
End Sub
Private Sub ReadRouteInfo()
Dim intIndex As Integer
对于intIndex = 71 To（71 + intTtlRoutes - 1）
如果intIndex< = 90然后
intRow = 3
ActiveSheet.Range（Chr（intIndex）& intRow）。选择
strRun（intIndex - 70）= ActiveCell.Value
intRow = 4
ActiveSheet.Range（Chr（intIndex）& intRow）。选择
intTotal（intIndex - 70）= ActiveCell.Value
intRow = 5
ActiveSheet.Range（Chr（intIndex）& intRow）。选择
intTaken（intIndex - 70）= ActiveCell.Value
intRow = 9
ActiveSheet.Range（Chr（intIndex）& intRow）。选择
sngRunTime（intIndex - 70）= ActiveCell.Value
否则为
intRow = 3
ActiveSheet.Range（QUOT; A"&安培; CHR（intIndex - 26）及intRow）。选择
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP; strRun（intIndex - 90）= ActiveCell.Value
intRow = 4
ActiveSheet.Range（QUOT; A"&安培; CHR（intIndex - 26）及intRow）。选择
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP; intTotal（intIndex - 90）= ActiveCell.Value
intRow = 5
ActiveSheet.Range（"& Chr（intIndex - 26）& intRow）。选择
&NBSP; intTaken（intIndex - 90）= ActiveCell.Value
intRow = 9
ActiveSheet.Range（"& Chr（intIndex - 26）& intRow）。选择
&NBSP; sngRunTime（intIndex - 90）= ActiveCell.Value
结束如果是
next intIndex
End Sub
Private Sub JSPCheckEmptys（）
Dim intX As Integer
对于intRow = 12 To（11 + intTtlDrivers）
对于intX = 71 To（71 + intTtlRoutes - 1）
如果intX< = 90然后
范围（Chr（intX）& intRow）。选择
否则b $ b 范围（" A"&安培; CHR（INTX - 26）及intRow）。选择
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;结束如果
如果ActiveCell.Text =""然后是
strProblems = strProblems& "行" &安培; intRow& " -Empty Cell ..." '空单元格<
结束如果
下一个intX
Next intRow
End Sub
Private Sub JSPCheckSum（）
Dim intIndex As Integer
Dim intNext As Integer
intNext = 0
对于intIndex = 1到intTtlRoutes
intNext = intNext + intIndex
下一个intIndex
intSum = intNext '这是我们针对准确性检查所有行的原因
'-------------
Dim intIndex As Integer
For intIndex = 71 To (71 + intTtlRoutes - 1)
If intIndex <= 90 Then
intRow = 3
ActiveSheet.Range(Chr(intIndex) & intRow).Select
strRun(intIndex - 70) = ActiveCell.Value
intRow = 4
ActiveSheet.Range(Chr(intIndex) & intRow).Select
intTotal(intIndex - 70) = ActiveCell.Value
intRow = 5
ActiveSheet.Range(Chr(intIndex) & intRow).Select
intTaken(intIndex - 70) = ActiveCell.Value
intRow = 9
ActiveSheet.Range(Chr(intIndex) & intRow).Select
sngRunTime(intIndex - 70) = ActiveCell.Value
Else
intRow = 3
ActiveSheet.Range("A" & Chr(intIndex - 26) & intRow).Select
strRun(intIndex - 90) = ActiveCell.Value
intRow = 4
ActiveSheet.Range("A" & Chr(intIndex - 26) & intRow).Select
intTotal(intIndex - 90) = ActiveCell.Value
intRow = 5
ActiveSheet.Range("A" & Chr(intIndex - 26) & intRow).Select
intTaken(intIndex - 90) = ActiveCell.Value
intRow = 9
ActiveSheet.Range("A" & Chr(intIndex - 26) & intRow).Select
sngRunTime(intIndex - 90) = ActiveCell.Value
End If
Next intIndex
End Sub
Private Sub JSPCheckEmptys()
Dim intX As Integer
For intRow = 12 To (11 + intTtlDrivers)
For intX = 71 To (71 + intTtlRoutes - 1)
If intX <= 90 Then
Range(Chr(intX) & intRow).Select
Else
Range("A" & Chr(intX - 26) & intRow).Select
End If
If ActiveCell.Text = "" Then
strProblems = strProblems & "Row " & intRow & " -Empty Cell..." 'Empty cell
End If
Next intX
Next intRow
End Sub
Private Sub JSPCheckSum()
Dim intIndex As Integer
Dim intNext As Integer
intNext = 0
For intIndex = 1 To intTtlRoutes
intNext = intNext + intIndex
Next intIndex
intSum = intNext 'This is what we check all rows against for accuracy
'-------------
Dim int选择As Integer
Dim intValue As Integer
Dim intDsrSum As Integer
对于intIndex = 12 To（12 + intTtlDrivers - 1）
'车手姓名
范围（"D"& intIndex）。选择
strDriver（intIndex - 11）= ActiveCell.Value
'检查DSR的总和
intDsrSum = 0
Dim intSelects As Integer
Dim intValue As Integer
Dim intDsrSum As Integer
For intIndex = 12 To (12 + intTtlDrivers - 1)
'Driver's names
Range("D" & intIndex).Select
strDriver(intIndex - 11) = ActiveCell.Value
'Check the DSR's Sum
intDsrSum = 0
对于intSelects = 71 To（71 + intTtlRoutes - 1）
如果intSelects< = 90那么
b $ b 范围（Chr（intSelects）& intIndex）。选择
否则b $ b 范围（"A"& Chr（intSelects - 26）& intIndex）。选择
结束如果
intValue = ActiveCell.Value
intDsrSum = intDsrSum + intValue
Next int选择
如果intDsrSum<> intSum然后
strProblems = strProblems& "不正确的JSP - " &安培;修剪（strDriver（intIndex - 11））& " ..."
结束如果是
下一个intIndex
结束子
Private Sub ReadDriverInfo（）
'驱动程序变量
'Dim intDriver（1到25， 1至25）As Integer '司机首选项
'Dim strDriver（1至25）As String * 25 '姓名
'Dim blnOut（1至25）As Boolean '司机开出或送出
Dim intIndex As Integer
Dim int选择As Integer
Dim intValue As Integer
对于intIndex = 12 To（12 + intTtlDrivers - 1）
'司机的可用时间为
范围（"B"& intIndex）。选择
如果ActiveCell.Text<> ""然后是
sngDsrTime（intIndex - 11）= ActiveCell.Value
否则为
sngDsrTime（intIndex - 11）= 0
结束如果
'司机开出或送出$
范围（"F"& intIndex）。选择
如果UCase（ActiveCell.Value）="y"，或UCase（ActiveCell.Value）=" Y"然后是
blnOut（intIndex - 11）= True
否则为
blnOut（intIndex - 11）= False
结束如果
'司机选择信息
'在阅读每个司机的偏好时，我已经放置了
'基于偏好的每个驾驶员阵列中的偏好。
'（1）应该是他们的第一个偏好，（2）秒，等等。
对于intSelects = 71 To（71 + intTtlRoutes - 1）
如果intSelects< = 90那么
b $ b 范围（Chr（intSelects）& intIndex）。选择
否则b $ b 范围（" A"&安培; CHR（intSelects - 26）及intIndex）。选择
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;结束如果
intValue = ActiveCell.Value
intDriver（intIndex - 11，intValue）= intSelects - 70
Next int选择
下一个intIndex
For intSelects = 71 To (71 + intTtlRoutes - 1)
If intSelects <= 90 Then
Range(Chr(intSelects) & intIndex).Select
Else
Range("A" & Chr(intSelects - 26) & intIndex).Select
End If
intValue = ActiveCell.Value
intDsrSum = intDsrSum + intValue
Next intSelects
If intDsrSum <> intSum Then
strProblems = strProblems & "Incorrect JSP -" & Trim(strDriver(intIndex - 11)) & "..."
End If
Next intIndex
End Sub
Private Sub ReadDriverInfo()
'DRIVER VARIABLES
'Dim intDriver(1 To 25, 1 To 25) As Integer 'Driver Preferences
'Dim strDriver(1 To 25) As String * 25 'Name
'Dim blnOut(1 To 25) As Boolean 'Driver in or out
Dim intIndex As Integer
Dim intSelects As Integer
Dim intValue As Integer
For intIndex = 12 To (12 + intTtlDrivers - 1)
'Driver's Time Available
Range("B" & intIndex).Select
If ActiveCell.Text <> "" Then
sngDsrTime(intIndex - 11) = ActiveCell.Value
Else
sngDsrTime(intIndex - 11) = 0
End If
'Driver in or out
Range("F" & intIndex).Select
If UCase(ActiveCell.Value) = "y" Or UCase(ActiveCell.Value) = "Y" Then
blnOut(intIndex - 11) = True
Else
blnOut(intIndex - 11) = False
End If
'Driver Selection Information
'When reading each driver's preferences, I've placed the
'preference in each driver's array based on preference.
'(1) should be their first preference, (2) second, etc.
For intSelects = 71 To (71 + intTtlRoutes - 1)
If intSelects <= 90 Then
Range(Chr(intSelects) & intIndex).Select
Else
Range("A" & Chr(intSelects - 26) & intIndex).Select
End If
intValue = ActiveCell.Value
intDriver(intIndex - 11, intValue) = intSelects - 70
Next intSelects
Next intIndex
结束子
'************************** ***********************************************
'************************************************ *********************
End Sub
'*********************************************************************
'*********************************************************************
Private Sub AssignRoutes（）
'DRIVER VARIABLES
'Dim intDriver（1到25,1到25）As Integer '司机首选项
'Dim strDriver（1至25）As String * 25 '姓名
'Dim blnOut（1至25）As Boolean '司机开出或送出
Dim intX As Integer
Dim intY As Integer
Dim intPref As Integer '司机的偏好为
Dim blnDone As Boolean
对于intY = 1到intTtlDrivers '下载司机列表
blnDone = False 'reset
范围（"F"&（intY + 11））。选择 'DSR输出了吗？
$
'如果司机外出，他们会被跳过。
如果UCase（ActiveCell.Value）<> " Y"然后&NBSP; 'DSR输出了吗？
intX = 1
Do Until blnDone = True
intPref = intDriver（intY，intX）
'检查偏好是否开放且DSR是否有足够的时间
; "如果（intTaken（intPref）LT; intTotal（intPref））然后
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;如果（intTaken（intPref）LT; intTotal（intPref））和（sngDsrTime（intY的）GT; = sngRunTime（intPref））然后
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; intTaken（intPref）= intTaken（intPref）+ 1 "减去运行
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; strDsrRun（intY）= strRun（intPref） '分配偏好为
blnDone =真&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; '完成
（路由已分配）
否则，
INTX = INTX + 1个
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;如果intX> intTtlRoutes那么"难道我们检查了所有的路线
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; strDsrRun（intY的）=" ZZZ"
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; blnDone = True "完成（NO路径分配）
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;结束如果是
如果（intTaken（intPref）LT; intTotal（intPref））和（sngDsrTime（intY的）LT; sngRunTime（intPref））然后
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;范围（"A"&（intY + 11））。选择
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; ActiveCell.FormulaR1C1 = QUOT;短"
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;结束如果
结束如果
循环
否则为
范围（"E"&（intY + 11））。选择 'DSR出局了。 保持路线
strDsrRun（intY）= ActiveCell.Value
结束如果是
下一个内容
结束次数
'******************************* ************************************** * $
'*** ************************************************** **************** * $ $ b $私人Sub ShowResults（）
Dim intIndex As Integer
Dim intRow As Integer
对于intIndex = 1到intTtlDrivers '下载司机列表
范围（"E"&（intIndex + 11））。选择
ActiveCell.FormulaR1C1 = UCase（strDsrRun（intIndex））
下一个intIndex
intRow = 5
对于intIndex = 71 To（71 + intTtlRoutes - 1） '沿着所拍摄的路线列出的价格为
如果intIndex< = 90然后
范围（Chr（intIndex）& intRow）。选择
否则为
范围（"A"& Chr（intIndex - 26）& intRow）。选择
结束如果
ActiveCell.FormulaR1C1 = intTaken（intIndex - 70）
下一个intIndex
'ActiveCell.FormulaR1C1 = intDriver（6,1）
'ActiveCell.FormulaR1C1 = blnOut（2）
'ActiveCell.FormulaR1C1 = strDsrRun（3）
$
结束子
'********************** ***************
'******************************************** *************************
Private Sub AssignProg（）
&NBSP; Dim blnDone As Boolean
Dim strTime As String
表格（"进展"）。选择
intIndex = 66 'B
intRow = 2
Do Until blnDone = True
Private Sub AssignRoutes()
'DRIVER VARIABLES
'Dim intDriver(1 To 25, 1 To 25) As Integer 'Driver Preferences
'Dim strDriver(1 To 25) As String * 25 'Name
'Dim blnOut(1 To 25) As Boolean 'Driver in or out
Dim intX As Integer
Dim intY As Integer
Dim intPref As Integer 'Driver's preference
Dim blnDone As Boolean
For intY = 1 To intTtlDrivers 'Goes down the list of drivers
blnDone = False 'reset
Range("F" & (intY + 11)).Select 'Is the DSR Out?
'If the driver is out, they get skipped
If UCase(ActiveCell.Value) <> "Y" Then 'Is the DSR Out?
intX = 1
Do Until blnDone = True
intPref = intDriver(intY, intX)
'Check to see if preference is open and DSR has enough time
'If (intTaken(intPref) < intTotal(intPref)) Then
If (intTaken(intPref) < intTotal(intPref)) And (sngDsrTime(intY) >= sngRunTime(intPref)) Then
intTaken(intPref) = intTaken(intPref) + 1 'Subtract run
strDsrRun(intY) = strRun(intPref) 'Assign preference
blnDone = True 'Done
(Route Assigned)
Else
intX = intX + 1
If intX > intTtlRoutes Then 'Have we checked all the routes?
strDsrRun(intY) = "ZZZ"
blnDone = True 'Done (No Route Assigned)
End If
If (intTaken(intPref) < intTotal(intPref)) And (sngDsrTime(intY) < sngRunTime(intPref)) Then
Range("A" & (intY + 11)).Select
ActiveCell.FormulaR1C1 = "short"
End If
End If
Loop
Else
Range("E" & (intY + 11)).Select 'DSR is Out. Keep Route
strDsrRun(intY) = ActiveCell.Value
End If
Next intY
End Sub
'*********************************************************************
'*********************************************************************
Private Sub ShowResults()
Dim intIndex As Integer
Dim intRow As Integer
For intIndex = 1 To intTtlDrivers 'Goes down the list of drivers
Range("E" & (intIndex + 11)).Select
ActiveCell.FormulaR1C1 = UCase(strDsrRun(intIndex))
Next intIndex
intRow = 5
For intIndex = 71 To (71 + intTtlRoutes - 1) 'Goes accross the list of Routes Taken
If intIndex <= 90 Then
Range(Chr(intIndex) & intRow).Select
Else
Range("A" & Chr(intIndex - 26) & intRow).Select
End If
ActiveCell.FormulaR1C1 = intTaken(intIndex - 70)
Next intIndex
'ActiveCell.FormulaR1C1 = intDriver(6, 1)
'ActiveCell.FormulaR1C1 = blnOut(2)
'ActiveCell.FormulaR1C1 = strDsrRun(3)
End Sub
'*********************************************************************
'*********************************************************************
Private Sub AssignProg()
Dim blnDone As Boolean
Dim strTime As String
Sheets("Progression").Select
intIndex = 66 'B
intRow = 2
Do Until blnDone = True
范围（Chr（intIndex）& intRow）。选择
如果ActiveCell.Value =""然后是
对于intRow = 2 to intTtlDrivers + 1
范围（CHR（intIndex）及intRow）。选择
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; ActiveCell.FormulaR1C1 = strDsrRun（intRow - 1）
Next intRow
blnDone = True
intRow = 27
范围（Chr（intIndex）&" 1"）。选择
如果分钟（时间）> 9然后
strTime =小时（时间）& "：" &安培;分钟（时间）
否则b $ b strTime =小时（时间）& "：0" &安培;分钟（时间）
结束如果
ActiveCell.FormulaR1C1 = strTime
结束如果
intIndex = intIndex + 1
如果intIndex = 87则为
blnDone = True
结束如果是
循环
Range(Chr(intIndex) & intRow).Select
If ActiveCell.Value = "" Then
For intRow = 2 To intTtlDrivers + 1
Range(Chr(intIndex) & intRow).Select
ActiveCell.FormulaR1C1 = strDsrRun(intRow - 1)
Next intRow
blnDone = True
intRow = 27
Range(Chr(intIndex) & "1").Select
If Minute(Time) > 9 Then
strTime = Hour(Time) & ":" & Minute(Time)
Else
strTime = Hour(Time) & ":0" & Minute(Time)
End If
ActiveCell.FormulaR1C1 = strTime
End If
intIndex = intIndex + 1
If intIndex = 87 Then
blnDone = True
End If
Loop
结束次数
'************* ************************************************** ******
'*********************************** **********************************
$
Sub ClearProg（）
'这是在工作表上"进展"&b
Dim intMsgValue As Integer
intMsgValue = MSGBOX（"你确定你想删除此电子表格中的信息与QUOT;？_
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;，vbYesNo）
如果intMsgValue = 6然后
范围（"B2：U28"）。选择
Selection.ClearContents
否则
MsgBox（"操作已取消。"）
结束如果是
结束子
End Sub
'*********************************************************************
'*********************************************************************
Sub ClearProg()
'This is on the Sheet"Progression"
Dim intMsgValue As Integer
intMsgValue = MsgBox("Are you sure you would like to delete the information on this spread sheet?" _
, vbYesNo)
If intMsgValue = 6 Then
Range("B2:U28").Select
Selection.ClearContents
Else
MsgBox ("Action Cancelled.")
End If
End Sub
'**************************** ******************************************
' ************************************************** *******************
私人子重置（）
'进展涵盖B2-U27
End Sub
'*********************************************************************
'*********************************************************************
Private Sub Reset()
'Progression covers B2-U27
End Sub
推荐答案
返回的错误信息是什么？
What is the error message returned?
错误发生在哪一行？
粘贴整个代码（而不是问题所在的焦点）使得一半的人避免这样的帖子......而另一半则三思而后行回答：D
Paste the whole code (instead of focus where the problem lies) makes half the ppl avoid such posts... and the other half think twice before answer :D
帮助我们：）
这篇关于宏 - 下标超出范围的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
