I want to merge cells in columns, if there is the same value in whole row.
Eg. If A1:G1 range is the same as A2:G2 I want to merge A1:A2 cells, B1:B2 to G1:G2.
With my code below I get run time error 13: type mismatch. I'm assuming, that problem is with checking equality of two ranges.
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
The question is, how to check if both ranges values are equal?
Edit after comments: With the code below it actually works
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
However, I'm wondering, why you(@Pᴇʜ) separeted the function for first and last rows.
Also, with my code, without merging cells I had te loop for change cell color:
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
How to deal with that after cells are merged?
The issue is that …
Range(Cells(i, 7), Cells(i, 24)).Value
returns an array of values, but you cannot compare an array of values with =
. Therefore you need to loop throug all these values and compare each value with the corresponding value in
Range(Cells(i - 1, 7), Cells(i - 1, 24)).Value
Since you already have this loop just move your If
statement to check this into the loop:
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
Note that I changed the variable naming to more meaningful names. This also avoids using Row
as variable name which is alerady used by Excel itself.
Edit according comments
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
Will turn the following
into
The value
property of a range returns an array if the range has more than one cell. You can either compare the values of each element in a loop, or you can use join()
to convert the arrays to strings and then compare those (see this answer).
来源:https://stackoverflow.com/questions/55237775/how-to-check-if-two-ranges-value-is-equal