如何在二维 VBA 数组中搜索最后一次出现的值,然后偏移该索引以找到不同的值?

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

我们的一个软件可以生成一个 28,000 行 64 列的 Excel 文件。 Excel文件没有数据格式;它是一堆空单元格、标题、标题、表中的表等。对于我的目的来说,重要的是在不同值的 last 出现之后找到值的 first 出现,以导入正确的数字到另一个 Excel 文件中。例如:

RANDOM DATA 123456           RANDOM DATA
RANDOM DATA 123456           RANDOM DATA
RANDOM DATA 123456           RANDOM DATA
RANDOM DATA RANDOM DATA  RANDOM DATA
RANDOM DATA RANDOM DATA  RANDOM DATA
RANDOM DATA RANDOM DATA  RANDOM DATA
RANDOM DATA RANDOM DATA  RANDOM DATA
RANDOM DATA RANDOM DATA  RANDOM DATA
RANDOM DATA RANDOM DATA  RANDOM DATA
RANDOM DATA RANDOM DATA      NEED THIS VALUE
RANDOM DATA RANDOM DATA      NEED THIS VALUE
RANDOM DATA RANDOM DATA  RANDOM DATA
RANDOM DATA RANDOM DATA  RANDOM DATA

在我制作的宏中,使用

Range.Find()
方法,我能够找到最后一个123456的单元格位置,然后
Range.Offset()
找到需要这个值的行数和列数。

这有效。但是,我需要在 28,000 行上运行

Range.Find()
方法 200 多次,这使得宏变慢。

我想将工作表保存到二维数组中并查找数组中的值而不是搜索工作表。但是,我对如何搜索数组中最后一次出现的值感到困惑,然后偏移该索引位置以在不同索引处找到不同的值。我需要什么样的循环?

编辑。添加我的旧代码,因为它是要求的。

Function GetMiles(TruckList() As String, FilePath As String)
    Dim OOWorkbook As Workbook 'This main workbook
    Dim DSWorkbook As Workbook 'Driver settlement workbook
    Dim TruckNumber As String 'To Save truck number
    Dim truck As Variant 'To loop through array
    Dim YOS As String 'Value of revenue
    Dim IntA As Integer 'For counting
    Dim TruckRange As Range 'The range to search for the truck number
    Dim TruckWhere As Range 'To store the cell number of the truck and access range properties
    Dim YOSWhere As Range 'To store the cell of Years of Service and access range properties
    Dim LastTruckCell As String 'Cell of the last occurrence of the truck
    Dim YOSCell As String 'Cell of the first occurence of the Year of Service
    Dim YOSCellRange As Range 'The range to search for the value of YOS based on the location of Years of Service
    Dim YOSRange As Range 'The range to search for Years of Service
    Dim UTruckList As Integer 'Check array size
    Dim GrossEarningsRange As Range 'The range to search for Gross Earnings
    Dim GrossWhere As Range 'To store cell of Gross Earnings and access range properties
    Dim GrossCell As String 'To store cell position of Gross Earnings
    Dim GrossOrYOS As String 'To check if the above row is Years of Service or something else
    Dim LCV As String 'To check if the truck is LCV or not
    
    'Set the OO workbook
    Set OOWorkbook = ThisWorkbook
    
    'Open Driver Settlement workbook
    Set DSWorkbook = Workbooks.Open(FilePath)
    
    'TruckArray = TruckList()
    UTruckList = UBound(TruckList)
    
    IntA = 0
    
    'Loop through tuck array
    For Each truck In TruckList
        If IntA > UTruckList Then 'Make sure IntA is within array index to handle subscript out of range error
            Exit For
        Else
            TruckNumber = TruckList(IntA) 'Access array value
            If TruckNumber = "" Then
                'Do nothing
            Else
                Set TruckRange = DSWorkbook.Worksheets(1).UsedRange 'Set the range to look for the truck number
                Set TruckWhere = TruckRange.Find(What:=TruckNumber, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious) 'Find the cell of the last occurrence of that truck number
                If (TruckWhere Is Nothing) Then 'Check if no truck was found
                    IntA = IntA + 1
                Else
                    LastTruckCell = TruckWhere.Address(0, 0) 'Get cell number of last occurence of truck number
                    Set GrossEarningsRange = DSWorkbook.Worksheets(1).UsedRange
                    Set GrossWhere = GrossEarningsRange.Find(What:="Total Gross Earnings on Trips", After:=Range(LastTruckCell), SearchOrder:=xlByRows, SearchDirection:=xlNext)
                    GrossCell = GrossWhere.Address(0, 0) 'Get cell position of Gross Earnings on Trips
                    Set YOSCellRange = DSWorkbook.Worksheets(1).Range(GrossCell) 'Set the range to search for the YOS value based on the cell number of Years of Service
                    GrossOrYOS = YOSCellRange.Offset(-1, 0)
                    If GrossOrYOS = "YEARS OF SERVICE" Then
                        YOS = YOSCellRange.Offset(-1, 17) 'Get the value of the YOS
                        LCV = OOWorkbook.Worksheets(TruckNumber).Range("D4").Value
                        If LCV = "LCV" Then
                            OOWorkbook.Worksheets(TruckNumber).Range("F12").Value = YOS 'to assign YOS to LCV cell
                        Else
                            OOWorkbook.Worksheets(TruckNumber).Range("E12").Value = YOS 'Update truck sheet with YOS value
                        End If
                    Else
                        'Do nothing/skip
                    End If
                    IntA = IntA + 1
                    Call GetCityWork(FilePath, GrossCell, LastTruckCell, TruckNumber)
                End If
            End If
        End If
    Next truck
End Function
arrays excel vba
1个回答
0
投票

这里有一种方法可以让你开始思考这个过程:

Sub Tester()
    Dim arr(1 To 100) As String, i
    For i = 1 To 100 'make some dummy truck data
        arr(i) = "Truck" & Format(i, "000")
    Next i
    GetMiles arr, "" 'not using the path here...
End Sub



Function GetMiles(TruckList() As String, FilePath As String)
    Dim wbOO As Workbook, wsDS As Workbook, rng As Range, data, t
    Dim dictTrucks As Object, dictLast As Object, r As Long, c As Long, v, k
    
    t = Timer
    
    Set wbOO = ThisWorkbook 'Set the OO workbook
    
    'Set wbds = Workbooks.Open(FilePath) 'Open Driver Settlement workbook
    'Set rng = wbds.Worksheets(1).UsedRange
    Set rng = ActiveSheet.Range("$A$1:$BL$28000") '### for testing
    
    data = rng.Value 'get as 2D array

    Set dictTrucks = ArrayToDict(TruckList) 'use dictionary for quick lookup
    Set dictLast = GetDict()                'an empty dictionary

    'Loop array in reverse and find last instance of all trucks in TruckList
    For r = UBound(data, 1) To 1 Step -1
        For c = UBound(data, 2) To 1 Step -1
            v = CStr(data(r, c))
            If dictTrucks.Exists(v) Then  'in TruckList?
                dictTrucks.Remove v       'remove after first found
                dictLast(v) = Array(r, c) 'store where found
            End If
        Next c
    Next r
    
    Debug.Print Timer - t 'approx 2-3 sec for 100 trucks
    'these are the locations of the last instances of elements in TruckList
    For Each k In dictLast
        Debug.Print k, "is at", Join(dictLast(k), ",")
    Next k

End Function

'convert a string array to a dictionary for lookup
Function ArrayToDict(arr() As String) As Object
    Dim i As Long, s As String
    Set ArrayToDict = GetDict()
    For i = LBound(arr) To UBound(arr)
        s = arr(i)
        ArrayToDict.Add s, False
    Next i
End Function
'return a case-insensitive dictionary object
Function GetDict() As Object
    Set GetDict = CreateObject("scripting.dictionary")
    GetDict.CompareMode = 1
End Function
© www.soinside.com 2019 - 2024. All rights reserved.