我们的一个软件可以生成一个 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
这里有一种方法可以让你开始思考这个过程:
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