Я предполагаю, что вы создали большую часть своего кода с помощью Macro Recorder. Устройство записи макросов не знает вашей цели, поэтому записывает каждое действие по мере его выполнения. Результат синтаксически правильный, но очень плохой VBA. Например, Select - медленная команда, которую любой учебник скажет вам не использовать. У Macro Recorder нет выбора. Вы добавили заявление With, которое не может использовать Macro Recorder.
Оскорбив ваше использование Macro Recorder, я признаю, что использовал его сам. Я не использую Import CSV file, Find and Sort достаточно часто, чтобы запомнить синтаксис или все параметры. Я обычно включаю Макро-рекордер, вручную выполняю одну из этих сложных команд, выключаю Макро-рекордер, а затем настраиваю записанный код в соответствии с рекомендуемыми стандартами.
Я создал две рабочие книги, которые соответствуют вашим описаниям: «Консультанты .xlsm "и" CustomerInfo.xlsx ". Для рабочего листа «Консультанты» я выбрал полдюжины имен из своего местного телефонного справочника и поместил их вдоль строки 1. Затем, начиная со строки 4, я разместил от одного до пяти названий компаний под каждым консультантом. Я создал лист «Заказы» в CustomerInfo.xlsx и скопировал выборку названий компаний в столбец A, начиная со строки 4.
Примечание. Я назвал таблицу данных. Это плохая идея использовать активный лист. Это полагается на то, что пользователь имеет активную правильную рабочую таблицу, и вводит в заблуждение код программиста по обслуживанию.
Создав рабочие книги и рабочие таблицы, я выполнил поиск одной из компаний в рабочей таблице «Консультанты» и использовал Macro Recorder для захвата синтаксиса. В результате получилось:
Sub Macro1()
Cells.Select
Selection.Find(What:="Spitfire Insurance", After:=ActiveCell, LookIn:= _
xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
End Sub
Затем я убрал этот код для своего макроса. Изучите разницу между приведенным выше кодом и окончательным кодом в моем макросе. Попробуйте понять, почему я сделал каждое изменение. При необходимости возвращайтесь с вопросами, но чем больше вы сможете работать самостоятельно, тем быстрее вы будете развивать свои навыки VBA.
Мой код ниже содержит два макроса: AssignConsultantToOrder() и FindLastRowCol().
В Excel VBA есть несколько способов поиска последней строки и столбца листа, но ни один из них не работает в любой ситуации. Раньше я решал, какую технику использовать для каждого нового макроса. Затем я решил написать макрос, который будет работать в любой известной мне ситуации, и добавить его в свою библиотеку. Я использую PERSONAL.XLSB в качестве библиотеки. У меня есть модули с именами «LibExcel», «LibOutlook» и «LibOffice». В эти модули я поместил макросы, разработанные для Excel, Outlook или любого пакета Microsoft Office. FindLastRowCol() находится в «LibExcel». Он использует каждую технику для поиска последней строки и столбца, а затем выбирает лучшие ответы. Не волнуйтесь об этой рутине на данный момент. Если у вас есть свободное время, я думаю, вы должны его изучить. Вы также можете подумать, что стоит создать PERSONAL.XLSB и скопировать в него этот макрос, чтобы он был доступен любому написанному макросу Excel.
Я считаю, что в AssignConsultantToOrder() достаточно комментариев, чтобы вы могли понять, Это. Однако при необходимости вернитесь с вопросами.
Option Explicit
' I avoid using numeric literal for row and column numbers.
' If a column, for example, is moved, working through your code looking for
' every reference to that column is a nightmare. If you use constant, one
' change and your code is adjusted.
Const RowConsultantsName As Long = 1
Const RowConsultantsDataFirst As Long = 4
Const ColOrdersCustomer As Long = 1
Const ColOrdersConsultant As Long = 2
Const RowOrdersDataFirst As Long = 4
Sub AssignConsultantToOrder()
Dim ColOrdersLast As Long
Dim ConsultantName As String
Dim CustomerName As String
Dim RngConsultant As Range
Dim RowOrdersCrnt As Long
Dim RowOrdersLast As Long
Dim WbkConsultants As Workbook
Dim WbkOrders As Workbook
Dim WshtConsultants As Worksheet
Dim WshtOrders As Worksheet
' I have created references to both workbooks. It should not matter
' which workbook or worksheet is active when you start the macro
Set WbkConsultants = Workbooks("Consultants.xlsm")
Set WbkOrders = Workbooks("CustomerInfo.xlsx")
Set WshtConsultants = WbkConsultants.Worksheets("Consultants")
Set WshtOrders = WbkOrders.Worksheets("Orders")
Call FindLastRowCol(WshtOrders, RowOrdersLast, ColOrdersLast)
' When I am developing a macro, I tend to write it in stages and use
' Debug.Print to prove that each stage is working before starting the
' next stage.
'Debug.Print "Orders " & RowOrdersLast & " " & ColOrdersLast
For RowOrdersCrnt = RowOrdersDataFirst To RowOrdersLast
CustomerName = WshtOrders.Cells(RowOrdersCrnt, ColOrdersCustomer).Value
'Debug.Print CustomerName
With WshtConsultants
Set RngConsultant = _
.Cells.Find(What:=CustomerName, After:=.Cells(RowConsultantsDataFirst - 1, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If RngConsultant Is Nothing Then
' Customer not found so do not know consultant
ConsultantName = ""
Else
' Extract consultant name
ConsultantName = .Cells(RowConsultantsName, RngConsultant.Column).Value
'Debug.Print ConsultantName
End If
End With
' Copy consultant name to orders worksheet
WshtOrders.Cells(RowOrdersCrnt, ColOrdersConsultant).Value = ConsultantName
Next
End Sub
Public Sub FindLastRowCol(ByRef Wsht As Worksheet, ByRef RowLast As Long, _
ByRef ColLast As Long)
' Sets RowLast and ColLast to the last row and column with a value
' in worksheet Wsht
' The motivation for coding this routine was the discovery that Find by
' previous row found a cell formatted as Merge and Center but Find by
' previous column did not.
' I had known the Find would miss merged cells but this was new to me.
' Dec16 Coded
' 31Dec16 Corrected handling of UserRange
' 15Feb17 SpecialCells was giving a higher row number than Find for
' no reason I could determine. Added code to check for a
' value on rows and columns above those returned by Find
' 25Jun17 Found column with value about that found by Find
Dim ColCrnt As Long
Dim ColLastFind As Long
Dim ColLastOther As Long
Dim ColLastTemp As Long
Dim ColLeft As Long
Dim ColRight As Long
Dim Rng As Range
Dim RowIncludesMerged As Boolean
Dim RowBot As Long
Dim RowCrnt As Long
Dim RowLastFind As Long
Dim RowLastOther As Long
Dim RowLastTemp As Long
Dim RowTop As Long
With Wsht
Set Rng = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious)
If Rng Is Nothing Then
RowLastFind = 0
ColLastFind = 0
Else
RowLastFind = Rng.Row
ColLastFind = Rng.Column
End If
Set Rng = .Cells.Find("*", .Range("A1"), xlValues, , xlByColumns, xlPrevious)
If Rng Is Nothing Then
Else
If RowLastFind < Rng.Row Then
RowLastFind = Rng.Row
End If
If ColLastFind < Rng.Column Then
ColLastFind = Rng.Column
End If
End If
Set Rng = .Range("A1").SpecialCells(xlCellTypeLastCell)
If Rng Is Nothing Then
RowLastOther = 0
ColLastOther = 0
Else
RowLastOther = Rng.Row
ColLastOther = Rng.Column
End If
Set Rng = .UsedRange
If Rng Is Nothing Then
Else
If RowLastOther < Rng.Row + Rng.Rows.Count - 1 Then
RowLastOther = Rng.Row + Rng.Rows.Count - 1
End If
If ColLastOther < Rng.Column + Rng.Columns.Count - 1 Then
ColLastOther = Rng.Column + Rng.Columns.Count - 1
End If
End If
If RowLastFind < RowLastOther Then
' Higher row found by SpecialCells or UserRange
Do While RowLastOther > RowLastFind
ColLastTemp = .Cells(RowLastOther, .Columns.Count).End(xlToLeft).Column
If ColLastTemp > 1 Or .Cells(RowLastOther, 1).Value <> "" Then
Debug.Assert False
' Is this possible
' Row after RowLastFind has value
RowLastFind = RowLastOther
Exit Do
End If
RowLastOther = RowLastOther - 1
Loop
ElseIf RowLastFind > RowLastOther Then
Debug.Assert False
' Is this possible
End If
RowLast = RowLastFind
If ColLastFind < ColLastOther Then
' Higher column found by SpecialCells or UserRange
Do While ColLastOther > ColLastFind
RowLastTemp = .Cells(.Rows.Count, ColLastOther).End(xlUp).Row
If RowLastTemp > 1 Or .Cells(1, ColLastOther).Value <> "" Then
'Debug.Assert False
' Column after ColLastFind has value
' Possible causes:
' * Find does not recognise merged cells
' ' Find does not examine hidden cells
ColLastFind = ColLastOther
Exit Do
End If
ColLastOther = ColLastOther - 1
Loop
ElseIf ColLastFind > ColLastOther Then
Debug.Assert False
' Is this possible
End If
ColLast = ColLastFind
End With
End Sub