Работает ли этот подход, зависит от того, выполняются ли все следующие условия:
- Вы можете заранее указать, какие столбцы в CSV соответствуют столбцам A и G из
Sheet6
- Вы можете заранее указать, какой столбец вашего CSV вы хотите записать в столбец E из
Sheet6
- Ни одно из самих значений в вашем CSV не содержит символов новой строки или запятых.
Я надеюсь, что все имеет смысл. ^
Option Explicit
Const CSV_FILE_PATH As String = "T:\Hex\ModeS-Mil.txt"
Const FIRST_ROW_CONTAINING_DATA As Long = 2 ' Exclude header row'
Sub FillMTextFile()
Dim csvMap As Collection
Set csvMap = GetMapForCsv()
Dim lastRow As Long
lastRow = Sheet6.Cells(Sheet6.Rows.Count, "A").End(xlUp).Row
Debug.Assert lastRow >= FIRST_ROW_CONTAINING_DATA
Dim substringsInColumnA() As Variant ' This needs a better name, especially if your columns change.'
substringsInColumnA = Sheet6.Range("A" & FIRST_ROW_CONTAINING_DATA, "A" & lastRow).Value
Dim substringsInColumnG() As Variant ' This needs a better name, especially if your columns change.'
substringsInColumnG = Sheet6.Range("G" & FIRST_ROW_CONTAINING_DATA, "G" & lastRow).Value
Dim outputRowCount As Long
outputRowCount = lastRow - FIRST_ROW_CONTAINING_DATA + 1
Dim arrayToWriteToSheet() As String
ReDim arrayToWriteToSheet(1 To outputRowCount, 1 To 1)
Debug.Assert LBound(arrayToWriteToSheet, 1) = LBound(substringsInColumnA, 1)
Dim rowIndex As Long
For rowIndex = LBound(substringsInColumnA, 1) To UBound(substringsInColumnA, 1)
Dim substringsToJoin(0 To 1) As String ' Static, re-use every iteration'
substringsToJoin(0) = UCase$(CStr(substringsInColumnA(rowIndex, 1)))
substringsToJoin(1) = UCase$(CStr(substringsInColumnG(rowIndex, 1)))
Dim substringToSearchFor As String
substringToSearchFor = Join$(substringsToJoin, ",")
arrayToWriteToSheet(rowIndex, 1) = _
GetCollectionItemOrDefault(someCollection:=csvMap, someKey:=substringToSearchFor)
Next rowIndex
Sheet6.Cells(FIRST_ROW_CONTAINING_DATA, "E").Resize(UBound(arrayToWriteToSheet, 1), UBound(arrayToWriteToSheet, 2)) = arrayToWriteToSheet
End Sub
Private Function GetMapForCsv() As Collection
' This function tries to take advantage of which columns '
' in the CSV to look at -- and builds a collection in which: '
' • each collection key = the concatenation of columns that need to contain matches '
' • each collection item = the value that we later want to look up '
Const CSV_COLUMN_TO_WRITE_TO_COLUMN_E As Long = 1 ' First column'
Const CSV_COLUMN_CORRESPONDING_TO_COLUMN_A As Long = 2 ' Second column'
Const CSV_COLUMN_CORRESPONDING_TO_COLUMN_G As Long = 3 ' Third column'
Dim outputCollection As Collection
Set outputCollection = New Collection
Dim fileHandle As Long
fileHandle = FreeFile
Open CSV_FILE_PATH For Input As #fileHandle ' Open once outside of loop.'
Do Until EOF(fileHandle)
' File is probably too large to fit in memory, hence iterating line by line'
' but I think this assumes there are no escaped/quoted new line characters in the values themselves'
Dim currentLineInCsv As String
Line Input #fileHandle, currentLineInCsv
currentLineInCsv = UCase$(currentLineInCsv)
Dim currentValues() As String
currentValues = Split(currentLineInCsv, ",", -1, vbBinaryCompare)
Dim toJoin(0 To 1) As String
toJoin(0) = currentValues(CSV_COLUMN_CORRESPONDING_TO_COLUMN_A - 1) ' 0-based array assumed'
toJoin(1) = currentValues(CSV_COLUMN_CORRESPONDING_TO_COLUMN_G - 1) ' 0-based array assumed'
Dim collectionKey As String
collectionKey = Join$(toJoin, ",")
Dim collectionItem As String
collectionItem = currentValues(CSV_COLUMN_TO_WRITE_TO_COLUMN_E - 1) ' 0-based array assumed'
On Error Resume Next
outputCollection.Add Item:=collectionItem, key:=collectionKey
On Error GoTo 0
Loop
Close #fileHandle
Set GetMapForCsv = outputCollection
End Function
Private Function GetCollectionItemOrDefault(ByVal someCollection As Collection, ByVal someKey As String, Optional ByVal defaultValue As String = vbNullString) As String
' Returns the item corresponding to some key of a collection'
' If the key does not exist, returns the default.'
Dim keyDoesNotExist As Boolean
Dim itemToReturn As String
On Error Resume Next
itemToReturn = someCollection(someKey)
keyDoesNotExist = (Err.Number <> 0)
On Error GoTo 0
If keyDoesNotExist Then itemToReturn = defaultValue
GetCollectionItemOrDefault = itemToReturn
End Function
Что касается реализации, вам нужно изменить эти строки (в коде для функции GetMapForCsv):
Const CSV_COLUMN_TO_WRITE_TO_COLUMN_E As Long = 1 ' First column'
Const CSV_COLUMN_CORRESPONDING_TO_COLUMN_A As Long = 2 ' Second column'
Const CSV_COLUMN_CORRESPONDING_TO_COLUMN_G As Long = 3 ' Third column'
так, чтобы назначения были верны для вашего CSV. В настоящее время вышеуказанные задания предполагают, что:
- второй столбец в вашем CSV соответствует значениям в
Sheet6 столбце A
- третий столбец в вашем CSV соответствует значениям в
Sheet6 столбце G
- вы хотите посмотреть значения в первом столбце вашего CSV и записать их в столбец
Sheet6 E.
Мой CSV содержал только 3 столбца, мой Sheet6 содержал 10 тыс. Значений для поиска; и на моей машине код выше взял:
- ~ 195,6 секунд для 10 миллионов строк в CSV
- ~ 35,2 секунды для 2 миллионов строк в CSV
Альтернативные подходы могут включать:
Использование Python. Должно быть возможным использовать выражение генератора для циклического перебора 2 миллионов строк файла CSV с эффективным использованием памяти. Я думаю, что встроенный модуль csv может справиться с этой задачей, но вам также может понадобиться модуль / библиотека Python для взаимодействия с Excel, например openpyxl, XlsxWriter (чтобы вы могли прочитать значения в столбцах A и G). Код Python, вероятно, будет намного короче / проще в обслуживании.
Использование Power Query (который уже несколько лет является частью Excel в Windows). Вы можете прочитать столбцы A и G в одну таблицу, а CSV - в другую таблицу. Вывод, вероятно, будет загружен в виде таблицы на лист. Не уверен, насколько это будет эффективно / эффективно, но, возможно, стоит настроить данные таким образом, чтобы вы могли использовать Table.Merge. В противном случае, возможно, вы могли бы вернуться к Text.Contains или что-то еще.