У вас есть нежелательные разрывы строк в ряде мест в вашем коде. Скриншот, который вы разместили, показывает количество линий, выделенных красным; это места, где вы получите синтаксическую ошибку, потому что строка неполная.
Строка, на которой вы разбиваете, должна быть объединена со следующей строкой, чтобы получить такой результат:
lRow2 = Application.WorksheetFunction.Match(strPair,wsResult.Range("A:A"), False) В этом случае строка пыталась присвоить значение переменной lRow2с помощью встроенной MATCHфункции Excel, которая ищет значение в диапазоне и возвращает номер строки, в которой она находит совпадение. Однако, поскольку ваша строка была неполной, все, с чем она должна была работать, - это аргумент, сообщающий ей, какое значение искать. Вы можете сказать, что он был неполным по нескольким причинам - он был выделен красным цветом, был только один аргумент, и у него была открывающая скобка без закрывающей скобки.
В VBA каждая отдельная инструкция или метод должны содержаться в одной строке. Если вам нужно прочитать несколько строк для удобства чтения, вы можете использовать _подчеркивание, чтобы соединить две строки вместе. Вот ваш код, модифицированный, чтобы избежать разрывов строк:
Редакция:
Я предположил, что две оставшиеся строки с ошибками ведут подсчет количества найденного определенного значения, поэтому они просто увеличивают значение в конкретной ячейке на 1 каждый раз. Попробуй и дай мне знать, что ты получишь.
Sub MostCommonPairAndTriplet() Dim rng As Range Dim c As Range Dim strPair As String Dim strTriplet As String Dim wsResult As Worksheet Dim lRow As Long Dim lRow2 As Long Dim i As Integer Dim j As Integer Application.ScreenUpdating = False Application.DisplayAlerts = False Set rng = Intersect(ActiveSheet.UsedRange, ActiveSheet.Range("A:F")) If Not rng Is Nothing Then 'Get the result worksheet On Error Resume Next Set wsResult = ActiveWorkbook.Worksheets("Results") If wsResult Is Nothing Then Set wsResult = ActiveWorkbook.Worksheets.Add wsResult.Name = "Results" Else wsResult.UsedRange.Delete End If 'column labels With wsResult .Range("B1").Value = "Value1" .Range("C1").Value = "Value2" .Range("D1").Value = "Count" .Range("F1").Value = "Value1" .Range("G1").Value = "Value2" .Range("H1").Value = "Value3" .Range("I1").Value = "Count" End With On Error GoTo 0 'Find Pairs lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column strPair = c.Value & "_" & c.Offset(0, i).Value On Error Resume Next lRow2 = Application.WorksheetFunction.Match(strPair, wsResult.Range("A:A"), False) If Err.Number > 0 Then wsResult.Range("A" & lRow).Value = strPair wsResult.Range("B" & lRow).Value = c.Value wsResult.Range("C" & lRow).Value = c.Offset(0, i).Value wsResult.Range("D" & lRow).Value = 1 lRow = lRow + 1 Else wsResult.Range("D" & lRow2).Value = wsResult.Range("D" & lRow2).Value + 1 End If On Error GoTo 0 Next i End If Next c 'Find Triplets lRow = 2 For Each c In rng If c.Column <= 5 Then For i = 1 To 6 - c.Column For j = 1 To 6 - c.Offset(0, i).Column strTriplet = c.Value & "_" & c.Offset(0, i).Value & "_" & c.Offset(0, i + j).Value On Error Resume Next lRow2 = Application.WorksheetFunction.Match(strTriplet, wsResult.Range("E:E"), False) If Err.Number > 0 Then wsResult.Range("E" & lRow).Value = strTriplet wsResult.Range("F" & lRow).Value = c.Value wsResult.Range("G" & lRow).Value = c.Offset(0, i).Value wsResult.Range("H" & lRow).Value = c.Offset(0, i + j).Value wsResult.Range("I" & lRow).Value = 1 lRow = lRow + 1 Else wsResult.Range("I" & lRow2).Value = wsResult.Range("I" & lRow2).Value + 1 End If On Error GoTo 0 Next j Next i End If Next c End If wsResult.Columns("E").Clear wsResult.Columns("A").Delete 'Sort the pairs With wsResult .Columns("A:C").Sort Key1:=.Range("C2"), Order1:=xlDescending .Columns("E:H").Sort Key1:=.Range("H2"), Order1:=xlDescending End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub