Sie haben in Ihrem Code an mehreren Stellen unerwünschte Zeilenumbrüche. Der von Ihnen gepostete Screenshot zeigt eine Reihe rot markierter Zeilen. Dies sind Orte, an denen Sie einen Syntaxfehler erhalten, weil die Zeile unvollständig ist.
Die Zeile, in der Sie brechen, sollte mit der nächsten Zeile kombiniert werden, um dieses Ergebnis zu erhalten:
lRow2 = Application.WorksheetFunction.Match(strPair,wsResult.Range("A:A"), False) In diesem Fall versuchte die Zeile, der Variablen lRow2mithilfe der integrierten MATCHFunktion von Excel einen Wert zuzuweisen. Diese Funktion sucht nach einem Wert innerhalb eines Bereichs und gibt die Zeilennummer zurück, an der die Übereinstimmung gefunden wird. Da Ihre Zeile jedoch unvollständig war, musste sie nur mit dem Argument arbeiten, nach welchem Wert gesucht werden soll. Man kann sagen, dass es auf verschiedene Weise unvollständig war - es wurde rot hervorgehoben, es gab nur ein Argument und es gab eine öffnende Klammer ohne schließende Klammer.
In VBA sollte jede einzelne Anweisung oder Methode in einer einzelnen Zeile enthalten sein. Wenn Sie zur besseren Lesbarkeit auf mehrere Zeilen zugreifen müssen, können Sie den _Unterstrich verwenden, um zwei Zeilen miteinander zu verbinden. Hier ist Ihr Code, geändert, um die Zeilenumbrüche zu vermeiden:
BEARBEITET:
Ich bin davon ausgegangen, dass die beiden verbleibenden fehlerhaften Zeilen eine Zählung darüber enthalten, wie viele eines bestimmten Werts gefunden werden. Sie erhöhen also einfach den Wert in einer bestimmten Zelle jedes Mal um 1. Lass es laufen und lass mich wissen, was du bekommst.
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