Você tem quebras de linha indesejadas em vários lugares do seu código. A captura de tela que você postou mostra várias linhas destacadas em vermelho; estes são lugares onde você receberá um erro de sintaxe, porque a linha está incompleta.
A linha em que você está invadindo deve ser combinada com a próxima linha, para obter esse resultado:
lRow2 = Application.WorksheetFunction.Match(strPair,wsResult.Range("A:A"), False)
Nesse caso, a linha estava tentando atribuir um valor à variável lRow2 usando a função MATCH incorporada do Excel, que procura um valor dentro de um intervalo e retorna o número da linha onde encontra a correspondência. . No entanto, desde que sua linha estava incompleta, tudo o que tinha que trabalhar era o argumento dizendo qual valor procurar. Você pode dizer que ele estava incompleto de várias maneiras - ele estava destacado em vermelho, havia apenas um argumento, e ele tinha um parêntese de abertura sem um parêntese de fechamento.
No VBA, cada instrução ou método individual deve estar contido em uma única linha. Se você precisar atravessar várias linhas para facilitar a leitura, poderá usar o sublinhado _ para unir duas linhas. Aqui está o seu código, modificado para evitar as quebras de linha:
EDITADO:
Eu assumi que as duas linhas restantes com erro estão mantendo uma contagem de quantos de um determinado valor são encontrados, então eles estão simplesmente incrementando o valor em uma célula em particular por 1 a cada vez. Dê uma corrida e deixe-me saber o que você tem.
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