Как проверить, равны ли значения двух диапазонов - PullRequest
0 голосов
/ 19 марта 2019

Я хочу объединить ячейки в столбцах, если во всей строке одинаковое значение.
Например. Если диапазон A1: G1 совпадает с диапазоном A2: G2, я хочу объединить ячейки A1: A2, от B1: B2 до G1: G2.
С моим кодом ниже я получаю ошибку времени выполнения 13: несоответствие типов. Я предполагаю, что проблема заключается в проверке равенства двух диапазонов.

Dim i As Long, j As Long, row as Long
row = Cells(Rows.Count, 6).End(xlUp).row
For i = row To 7 Step -1
        If Range(Cells(i, 7), Cells(i, 24)).Value = Range(Cells(i - 1, 7), Cells(i - 1, 24)).Value Then
        For j = 7 To 24 Step 1
            Range(Cells(i, j), Cells(i - 1, j)).Merge
        Next j
        End If
Next i

Вопрос в том, как проверить, равны ли значения обоих диапазонов?

Редактировать после комментариев: С кодом ниже это на самом деле работает

Dim i As Long, j As Long, row As Long
row = Cells(Rows.Count, 6).End(xlUp).row
For i = row To 7 Step -1
        If Join(Application.Transpose(Application.Transpose(Range(Cells(i, 7), Cells(i, 24)))), Chr(0)) = Join(Application.Transpose(Application.Transpose(Range(Cells(i - 1, 7), Cells(i - 1, 24)))), Chr(0)) Then
        For j = 7 To 24 Step 1
            Range(Cells(i, j), Cells(i - 1, j)).Merge
            Application.DisplayAlerts = False
        Next j
        End If
Next i

Однако мне интересно, почему вы (@ Pᴇʜ) разделили функцию для первой и последней строк.

Кроме того, с моим кодом, без объединения ячеек, у меня был цикл для изменения цвета ячейки:

Dim row As Long
row = Cells(Rows.Count, 6).End(xlUp).ro
Do Until IsEmpty(Cells(row, 3))
     If row Mod 2 <> 0 Then
       Range(Cells(row, 3), Cells(row, 24)).Interior.Color = RGB(217, 225, 242)
     Else
       Range(Cells(row, 3), Cells(row, 24)).Interior.Color = xlNone
     End If
     row = row + 1
Loop

Как бороться с этим после объединения клеток?

Ответы [ 2 ]

2 голосов
/ 19 марта 2019

Свойство value диапазона возвращает массив, если диапазон имеет более одной ячейки. Вы можете либо сравнить значения каждого элемента в цикле, либо использовать join() для преобразования массивов в строки, а затем сравнить их (см. этот ответ ).

2 голосов
/ 19 марта 2019

Проблема в том, что ...

Range(Cells(i, 7), Cells(i, 24)).Value

возвращает массив значений, но вы не можете сравнить массив значений с =. Поэтому вам необходимо выполнить цикл по всем этим значениям и сравнить каждое значение с соответствующим значением в

Range(Cells(i - 1, 7), Cells(i - 1, 24)).Value

Поскольку у вас уже есть этот цикл, просто переместите оператор If, чтобы проверить это в цикле:

Dim iRow As Long, iCol As Long, LastRow as Long
LastRow = Cells(Rows.Count, 6).End(xlUp).row
For iRow = LastRow To 7 Step -1
    For iCol = 7 To 24 Step 1
        If Cells(iRow, iCol).Value = Cells(iRow - 1, iCol).Value Then
            Range(Cells(iRow, iCol), Cells(iRow - 1, iCol)).Merge
        End If
    Next iCol 
Next iRow 

Обратите внимание, что я изменил именование переменных на более значимые имена. Это также позволяет избежать использования Row в качестве имени переменной, которая используется в самом Excel.


Редактировать в соответствии с комментариями

Option Explicit

Sub Test()
    Dim RangeToMerge As Range
    Set RangeToMerge = Range("C5:F14")

    Dim FirstMergeRow As Long
    FirstMergeRow = 1

    Dim iRow As Long, iCol As Long
    For iRow = 1 To RangeToMerge.Rows.Count - 1
        If Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(RangeToMerge.Rows(FirstMergeRow).Value)), "|") <> _
           Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(RangeToMerge.Rows(iRow + 1).Value)), "|") Then
            If iRow <> FirstMergeRow Then
                For iCol = 1 To RangeToMerge.Columns.Count
                    Application.DisplayAlerts = False
                    RangeToMerge.Cells(FirstMergeRow, iCol).Resize(rowsize:=iRow - FirstMergeRow + 1).Merge
                    Application.DisplayAlerts = True
                Next iCol
            End If
            FirstMergeRow = iRow + 1
        End If
    Next iRow

    'merge last ones
    If iRow <> FirstMergeRow Then
        For iCol = 1 To RangeToMerge.Columns.Count
            Application.DisplayAlerts = False
            RangeToMerge.Cells(FirstMergeRow, iCol).Resize(rowsize:=iRow - FirstMergeRow + 1).Merge
            Application.DisplayAlerts = True
        Next iCol
    End If
End Sub

Превратит следующее

enter image description here

в

enter image description here

...