Код, который у меня есть, работает, но он медленный, и я хочу избежать использования select.
Я пробовал что-то в строке следующего:
Sub PopulateBlastEvents()
Dim wsfr As Worksheet
Dim wsl As Worksheet
Dim BlNumber As String
Dim BSStep As Long
Dim SI As String
Dim Srng As Range
Dim Nrng As Range
Dim Arng As Range
Dim NotF As String
Dim Found As Range
Application.ScreenUpdating = False
NotF = "NO INFO"
BSStep = 1
Set Rrng = Sheets("Blast List").Range("A2:A45")
Set Srng = Sheets("Blast List").Range("E1:R1")
For Each cell In Rrng
If cell <> "" Then
For Each cell2 In Srng
If cell2 <> "" Then
On Error Resume Next
SI = cell.Value
BlNumber = CStr("Blasted " & BSStep)
Set wsfr = Sheets(CStr(BlNumber))
Set wsl = Sheets("Blast List")
With wsfr.Range("A:A")
Set Found = Cells.Find(What:=SI, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Found Is Nothing Then
With wsl.Range("A:A")
Set Found1 = Cells.Find(What:=BlNumber, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).End(xlToRight).Offset(0, 1)
Found1.Value = NotF
End With
Else
With wsl.Range("A:A")
Set Found1 = Cells.Find(What:=BlNumber, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).End(xlToRight).Offset(0, 1)
Found1.Value = Found.Value
End With
End If
End With
End If
Next cell2
BSStep = BSStep + 1
End If
Next cell
Set Arng = ThisWorkbook.Worksheets("Blast List").Range("E3:X3").End(xlDown).Select
Application.ScreenUpdating = True
Columns("A:S").EntireColumn.AutoFit
End Sub
Кодработает, но не возвращает значения, так как значение диапазона «rng» остается на НИЧЕГО, даже если оно находится на листе, где оно ищет значение.
Ниже приведен текущий код, который я использую, который необходимо изменить:
Sub PopulateBlastEvents()
Dim wsfr As Worksheet
Dim wsl As Worksheet
Dim BlNumber As String
Dim BSStep As Long
Dim SI As String
Dim Srng As Range
Dim Nrng As Range
Dim Rrng As Range
Dim Brng As Range
Dim Arng As Range
Dim NotF As String
Application.ScreenUpdating = False
NotF = "NO INFO"
BSStep = 1
Set Rrng = Sheets("Blast List").Range("A2:A45")
Set Srng = ThisWorkbook.Worksheets("Blast List").Range("E1:R1")
For Each Brng In Rrng.Cells
If Brng <> "" Then
For Each Nrng In Srng.Cells
If Nrng <> "" Then
On Error Resume Next
SI = Nrng.Value
BlNumber = CStr("Blasted " & BSStep)
Set wsfr = ThisWorkbook.Worksheets(CStr(BlNumber))
Set wsl = ThisWorkbook.Worksheets("Blast List")
wsfr.Select
Range("A1").Select
Cells.Find(What:=SI, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.Copy
If Err.Description <> "" Then
Sheets("Blast List").Select
Range("A1").Select
Cells.Find(What:=BlNumber, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).End(xlToRight).Offset(0, 1).Select
Selection.Value = NotF
Else
Sheets("Blast List").Select
Range("A1").Select
Cells.Find(What:=BlNumber, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).End(xlToRight).Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End If
Next Nrng
BSStep = BSStep + 1
End If
Next Brng
Set Arng = ThisWorkbook.Worksheets("Blast List").Range("E3:X3").End(xlDown).Select
Application.ScreenUpdating = True
Columns("A:X").EntireColumn.AutoFit
End Sub
Я действительно хочу ускорить код и все предыдущие вопросы, которые я отправил, меня проинформировали, чтобы не использовать или не использовать Select.
Пожалуйста, кто-нибудь может помочь.