У меня есть этот код VBA, когда я пытаюсь запустить его, он дает мне «Ошибка компиляции: ошибка синтаксиса», как видно на рисунке. Я не знаю VBA, что я должен сделать, чтобы этот код работал? Благодарю.

 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

1 ответ1

1

У вас есть нежелательные разрывы строк в ряде мест в вашем коде. Скриншот, который вы разместили, показывает количество линий, выделенных красным; это места, где вы получите синтаксическую ошибку, потому что строка неполная.

Строка, на которой вы разбиваете, должна быть объединена со следующей строкой, чтобы получить такой результат:

lRow2 = Application.WorksheetFunction.Match(strPair,wsResult.Range("A:A"), False)

В этом случае строка пыталась присвоить значение переменной lRow2 с помощью встроенной в Excel функции MATCH , которая ищет значение в диапазоне и возвращает номер строки, в которой она находит совпадение. Однако, поскольку ваша строка была неполной, все, с чем она должна была работать, - это аргумент, сообщающий ей, какое значение искать. Вы можете сказать, что он был неполным по нескольким причинам - он был выделен красным цветом, был только один аргумент, и у него была открывающая скобка без закрывающей скобки.

В 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

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .