我有一个 VBA 代码。应该如何将其转换为 VbScript 代码

Question

我有一个 VBA 代码，它可以在 excel 列中返回特定日期的单元格地址。

VBA 代码：-

Sub GetDates2()
    Const findDate As Date = #10/1/2020#
    Dim R As Range, C As Range, WS As Worksheet

Set WS = Worksheets("FY2021 Bank txn-stats")
Set R = WS.UsedRange

For Each C In R
    If C.Value2 = CDbl(findDate) Then MsgBox (findDate & " found in " & C.Address)
Next C
End Sub

现在我想要一个与上面的 VBA 代码相对应的 VBScript 代码，我应该能够在其中提供要查找的 excel 文件位置和日期。

我自己试过了，但没有输出。

VBScript 代码（我试过）：-

Sub GetDates2()
    Dim R,C,WS,findDate

Set findDate=#10/01/2020#
Set oExcel = CreateObject("Excel.Application")
Set oData = oExcel.Workbooks.Open(FileLocation)
Set WS = oData.Worksheets("FY2021 Bank txn-stats")
Set R = WS.Range("C1:C500").Cells

For Each C In R
    If C.Value = CDbl(findDate) Then MsgBox (findDate & " found in " & C.Address)
Next
End Sub

请帮帮我。

Answer 1

获取日期单元格地址

• 基本上，第一个VBA解决方案写在VBScript中。
• 请注意，您可以在VBScript 中编写第二个VBA 解决方案，您可以在VBA 中编写VBScript 解决方案。

VBA

Option Explicit

' All Occurrences (if not 'Exit For')
Sub GetDatesLoop()
    
    Const wsName As String = "FY2021 Bank txn-stats"
    Const fDate As Date = #10/1/2020#
    Const cCol As String = "C"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim rg As Range: Set rg = Intersect(ws.UsedRange, ws.Columns(cCol))
    
    If Not rg Is Nothing Then
        Dim c As Range
        For Each c In rg.Cells
            If c.Value = fDate Then ' Works without 'CDbl'.
                MsgBox fDate & " found in " & c.Address
                ' If you want the first occurrence only, use the following:
                'Exit For
            End If
        Next c
    End If

End Sub

' Faster, but First Occurrence Only
Sub GetDatesMatch()
    
    Const wsName As String = "FY2021 Bank txn-stats"
    Const fDate As Date = #10/1/2020#
    Const cCol As String = "C"
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    Dim rg As Range: Set rg = Intersect(ws.UsedRange, ws.Columns(cCol))
    
    If Not rg Is Nothing Then
        Dim cIndex As Variant
        cIndex = Application.Match(CDbl(fDate), rg, 0) ' Needs 'CDbl'.
        If IsNumeric(cIndex) Then
            MsgBox fDate & " found in " & rg.Cells(cIndex).Address
        End If
    End If

End Sub

VBScript

• 它将在 Excel 的另一个实例中打开文件，执行此工作并关闭 (Quit) 实例。
• 工作簿只是从中读取的，因此它是否已经在另一个 Excel 实例中打开并不重要。即使将Read-Only 设置为True 也不是必需的，但“感觉”是正确的。
• 请注意此xlApp.Intersect(...)（在VBA 中不需要Application.。）。
• 调整常量部分 (FilePath) 中的值。

Option Explicit

GetDatesLoop

Sub GetDatesLoop()
    
    Const FilePath = "F:\Test\Dates.xlsx"
    Const wsName = "FY2021 Bank txn-stats"
    Const fDate = #10/1/2020#
    Const cCol = "C"
    
    Dim xlApp: Set xlApp = CreateObject("Excel.Application")
    'xlApp.Visible = False ' Default. No need to 'show' what's happening.

    Dim wb: Set wb = xlApp.Workbooks.Open(FilePath, , True) ' (Read-Only = True)
    Dim ws: Set ws = wb.Worksheets(wsName)
    Dim rg: Set rg = xlApp.Intersect(ws.UsedRange, ws.Columns(cCol))

    If Not rg Is Nothing Then
        Dim c
        For Each c In rg.Cells
            If c.Value = fDate Then ' Works without 'CDbl'.
                MsgBox fDate & " found in " & c.Address
                ' If you want the first occurrence only, use the following:
                'Exit For
            End If
        Next
    End If
    
    wb.Close False ' (SaveChanges = False)
    xlApp.Quit
    
End Sub