VBScript：ADODB 连接到 Excel 变量范围

Question

我这里有一些工作代码，我正在尝试用整数到字母的解决方案来改进它们。

我有一个庞大的 Excel 电子表格，用户将使用 ADODB 根据他们的输入将其寻址到特定范围（以减少记录集大小）。

因此，如果输入为 1，则范围为 A1:H51，如果输入为 2，则其偏移量为 8 个字段。

现在，正如您在下面看到的，我正在做 50 个 If Then 语句。我的问题是如何使用变量来根据输入设置范围？

或者它是否足够好？看起来很复杂……

Dim SelectedSpreadsheetFromTxt
Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.OpenTextFile("C:\ProgramData\vizrt\Trio\GolfShotSheetSpreadsheetPath.txt")
    line = file.ReadLine
    file.Close

SelectedSpreadsheetFromTxt = line

Dim Message,Flag,Name,Score,Hole,Par,Shot,NullField
Dim objConnection, objRecordSet

    set objConnection = CreateObject("ADODB.Connection")
    set objRecordSet = CreateObject("ADODB.Recordset")

    objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" &_
    "Data Source=" & SelectedSpreadsheetFromTxt & ";" &_
    "Extended Properties=""Excel 12.0; HDR=Yes; IMEX=1"";"

'inputbox to ask for sheet number
Dim SheetFromInput
SheetFromInput = InputBox("What Shot Sheet?" & vbNewLine & "Enter the Number: 1,2,3,4,5, etc...","Shot Sheet")

Dim ShotRange
If SheetFromInput = 1 Then
    ShotRange = "Shot_Graphics$A1:H51" 
End If
If SheetFromInput = 2 Then
    ShotRange = "Shot_Graphics$I1:P51"
End If
If SheetFromInput = 3 Then
    ShotRange = "Shot_Graphics$Q1:X51"
End If
If SheetFromInput = 4 Then
    ShotRange = "Shot_Graphics$Y1:AF51"
End If
If SheetFromInput = 5 Then
    ShotRange = "Shot_Graphics$AG1:AN51"
End If
If SheetFromInput = 6 Then
    ShotRange = "Shot_Graphics$AO1:AV51"
End If
If SheetFromInput = 7 Then
    ShotRange = "Shot_Graphics$AW1:BD51"
End If
If SheetFromInput = 8 Then
    ShotRange = "Shot_Graphics$BE1:BL51"
End If
If SheetFromInput = 9 Then
    ShotRange = "Shot_Graphics$BM1:BT51"
End If
If SheetFromInput = 10 Then
    ShotRange = "Shot_Graphics$BU1:CB51"
End If
If SheetFromInput = 11 Then
    ShotRange = "Shot_Graphics$CC1:CJ51"
End If
If SheetFromInput = 12 Then
    ShotRange = "Shot_Graphics$CK1:CR51"
End If
If SheetFromInput = 13 Then
    ShotRange = "Shot_Graphics$CS1:CZ51"
End If
If SheetFromInput = 14 Then
    ShotRange = "Shot_Graphics$DA1:DH51"
End If
If SheetFromInput = 15 Then
    ShotRange = "Shot_Graphics$DI1:DP51"
End If
If SheetFromInput = 16 Then
    ShotRange = "Shot_Graphics$DQ1:DX51"
End If
If SheetFromInput = 17 Then
    ShotRange = "Shot_Graphics$DY1:EF51"
End If
If SheetFromInput = 18 Then
    ShotRange = "Shot_Graphics$EG1:EN51"
End If
If SheetFromInput = 19 Then
    ShotRange = "Shot_Graphics$EO1:EV51"
End If
If SheetFromInput = 20 Then
    ShotRange = "Shot_Graphics$EW1:FD51"
End If
If SheetFromInput = 21 Then
    ShotRange = "Shot_Graphics$FE1:FL51"
End If
If SheetFromInput = 22 Then
    ShotRange = "Shot_Graphics$FM1:FT51"
End If
If SheetFromInput = 23 Then
    ShotRange = "Shot_Graphics$FU1:GB51"
End If
If SheetFromInput = 24 Then
    ShotRange = "Shot_Graphics$GC1:GJ51"
End If
If SheetFromInput = 25 Then
    ShotRange = "Shot_Graphics$GK1:GR51"
End If
If SheetFromInput = 26 Then
    ShotRange = "Shot_Graphics$GS1:GZ51"
End If
If SheetFromInput = 27 Then
    ShotRange = "Shot_Graphics$HA1:HH51"
End If
If SheetFromInput = 28 Then
    ShotRange = "Shot_Graphics$HI1:HP51"
End If
If SheetFromInput = 29 Then
    ShotRange = "Shot_Graphics$HQ1:HX51"
End If
If SheetFromInput = 30 Then
    ShotRange = "Shot_Graphics$HY1:IF51"
End If
If SheetFromInput = 31 Then
    ShotRange = "Shot_Graphics$IG1:IN51"
End If
If SheetFromInput = 32 Then
    ShotRange = "Shot_Graphics$IO1:IV51"
End If
If SheetFromInput = 33 Then
    ShotRange = "Shot_Graphics$IW1:JD51"
End If
If SheetFromInput = 34 Then
    ShotRange = "Shot_Graphics$JE1:JL51"
End If
If SheetFromInput = 35 Then
    ShotRange = "Shot_Graphics$JM1:JT51"
End If
If SheetFromInput = 36 Then
    ShotRange = "Shot_Graphics$JU1:KB51"
End If
If SheetFromInput = 37 Then
    ShotRange = "Shot_Graphics$KC1:KJ51"
End If
If SheetFromInput = 38 Then
    ShotRange = "Shot_Graphics$KK1:KR51"
End If
If SheetFromInput = 39 Then
    ShotRange = "Shot_Graphics$KS1:KZ51"
End If
If SheetFromInput = 40 Then
    ShotRange = "Shot_Graphics$LA1:LH51"
End If
If SheetFromInput = 41 Then
    ShotRange = "Shot_Graphics$LI1:LP51"
End If
If SheetFromInput = 42 Then
    ShotRange = "Shot_Graphics$LQ1:LX51"
End If
If SheetFromInput = 43 Then
    ShotRange = "Shot_Graphics$LY1:MF51"
End If
If SheetFromInput = 44 Then
    ShotRange = "Shot_Graphics$MG1:MN51"
End If
If SheetFromInput = 45 Then
    ShotRange = "Shot_Graphics$MO1:MV51"
End If
If SheetFromInput = 46 Then
    ShotRange = "Shot_Graphics$MW1:ND51"
End If
If SheetFromInput = 47 Then
    ShotRange = "Shot_Graphics$NE1:NL51"
End If
If SheetFromInput = 48 Then
    ShotRange = "Shot_Graphics$NM1:NT51"
End If
If SheetFromInput = 49 Then
    ShotRange = "Shot_Graphics$NU1:OB51"
End If
If SheetFromInput = 50 Then
    ShotRange = "Shot_Graphics$OC1:OJ51"
End If

        objRecordSet.Open "SELECT * FROM [" & ShotRange & "]", objConnection

            MessageColumn = 0
            FlagColumn = 1
            NameColumn = 2
            ScoreColumn = 3
            HoleColumn = 4
            ParColumn = 5
            ShotColumn = 6
            NullFieldColumn = 7

    Do Until objRecordSet.EOF       
            Message = objRecordSet.Fields.Item(0)
            Flag = objRecordSet.Fields.Item(1)
            Name = objRecordSet.Fields.Item(2)
            Score = objRecordSet.Fields.Item(3)
            Hole = objRecordSet.Fields.Item(4)
            Par = objRecordSet.Fields.Item(5)
            Shot = objRecordSet.Fields.Item(6)
            NullField = objRecordSet.Fields.Item(7)

                TrioCmd("page:read_template SHOT_STROKEPLAY-FULL_GOLF")
                TrioCmd("page:set_property 0100 " & Flag)
                TrioCmd("page:set_property 0102 " & NullField)
                TrioCmd("page:set_property 0140 " & Name)
                TrioCmd("page:set_property 0150 " & Score)
                TrioCmd("page:set_property 0210 " & Hole)
                TrioCmd("page:set_property 0220 " & Par)
                TrioCmd("page:set_property 0230 " & Shot)
                TrioCmd("page:set_property 0320 " & NullField)
                TrioCmd("page:set_property 0330 " & NullField)
                TrioCmd("page:set_property 0410 " & NullField)
                TrioCmd("page:set_property 0510 " & NullField)
                TrioCmd("page:saveas " & Message)
    objRecordSet.MoveNext
    Loop

    objRecordSet.Close
    set objRecordSet = Nothing

    objConnection.Close
    set objConnection = Nothing

Answer 1

如果您打开了工作簿，那么您可以使用范围对象的偏移功能。然后你可以做类似的事情

baseRange = Range("A1:H51")

If SheetFromInput > 1 Then
    ShotRange = baseRange.Offset(0, (SheetFromInput - 1) * 8)
Else
    ShotRange = baseRange
End If

但是由于您正在执行查询，因此您需要创建函数来获取字母字符。为此，您可以使用 A-Z:65-90 的 ascii 值。除以 26 并从 64 开始，因为 1 = A 并且 64+1 是 A 的 aschii 值。

*请注意，这没有经过全面测试，可能会更有效地完成

If SheetFromInput > 1 Then
    ShotRange = "Shot_Graphics$" & getRangeAlpha((SheetFromInput - 1) * 8 + 1) & "1:" & getRangeAlpha((SheetFromInput - 1) * 8 + 8) & "51"
Else
    ShotRange = "Shot_Graphics$" & getRangeAlpha(1) & "1:" & getRangeAlpha(8) & "51"
End If




Function getRangeAlpha(val)
'Ascii 65-90 A-Z
'divide by 26
Dim numLetters
Dim numRemainingLetters
Dim letterRange

numLetters = val \ 26
numRemainingLetters = val Mod 26
'check to see if we are at ZZ (702)
'we do this as 27 returns AA in this function.  This is the only known issue.
If numLetters = 27 Then
    getRangeAlpha = "ZZ"
    Exit Function
End If
'check to see if we have three letters
If numLetters > 26 Then
    Dim numThirdLetter
    'get the value for the third letter (first in series)
    numThirdLetter = numLetters \ 26
    'set the next letter to the remaining value
    numLetters = numLetters Mod 26
    'add the letter
    letterRange = Chr(64 + numThirdLetter)
End If

If numLetters > 0 Then
    letterRange = letterRange + Chr(64 + numLetters)
End If
If numRemainingLetters > 0 Then
    letterRange = letterRange + Chr(64 + numRemainingLetters)
End If

getRangeAlpha = letterRange
End Function