VBScript: ADODB соединение с переменным диапазоном Excel - PullRequest
Новая
       34

VBScript: ADODB соединение с переменным диапазоном Excel

0 голосов
/ 08 мая 2018

У меня есть некоторый рабочий код, который я пытаюсь улучшить с помощью целочисленного алфавитного решения.

У меня есть массивная электронная таблица Excel, к которой пользователь будет обращаться с помощью ADODB к определенному диапазону на основе своего ввода (чтобы уменьшить размер набора записей).

Таким образом, если вход равен 1, диапазонA1: H51, и если вход равен 2, его смещение на 8 полей.

Прямо сейчас, как вы можете видеть ниже, я просто делаю «50 заявлений тогда».У меня вопрос, как я могу использовать переменную, чтобы установить диапазон на основе ввода?

Или это достаточно хорошо, как есть?Кажется сложным ... 

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

1 Ответ

0 голосов
/ 08 мая 2018

Если вы открыли книгу, то могли бы использовать функцию смещения объекта диапазона. Тогда вы могли бы сделать что-то вроде 

baseRange = Range("A1:H51")

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

но поскольку вы делаете запрос, вам нужно создать функцию для получения буквенных символов. Вы делаете это, используя значения ascii для A-Z: 65-90. Разделив на 26 и начиная с 64, так как 1 = A и 64 + 1 - это значение ашии для A.

* Обратите внимание, что это не полностью проверено и, вероятно, может быть сделано более эффективно 

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
...