问如果单元格区域中的某个值多次出现，则用该值替换该区域

EN

Sub test()

Dim wb As Workbook
Dim wsSource As Worksheet

Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sheet6")

Dim loopRange As Range
Dim currRow As Range

Set loopRange = wsSource.Range("B2:F6")

For Each currRow In loopRange.Rows

    If Application.WorksheetFunction.CountA(currRow) > 1 Then

        If FindFrequency(currRow)(1) > 1 Then

            With wsSource
                .Cells(currRow.Row, 2) = FindFrequency(currRow)(0)
                .Range(.Cells(currRow.Row, 3), .Cells(currRow.Row, 6)).ClearContents
            End With
        End If

    End If

Next currRow

End Sub

Function FindFrequency(currRow As Range) As Variant 'Adapted from here https://www.extendoffice.com/documents/excel/1581-excel-find-most-common-value.html#a2

Dim rng As Range
Dim dic As Object 'late binding
Dim xMax As Long
Dim xOutValue As String
Dim xValue As String
Dim xCount As Long

Set dic = CreateObject("scripting.dictionary")

On Error Resume Next

xMax = 0
xOutValue = ""

For Each rng In currRow.Columns

    xValue = rng.Text

    If xValue <> "" Then

        dic(xValue) = dic(xValue) + 1
        xCount = dic(xValue)

        If xCount > xMax Then
            xMax = xCount
            xOutValue = xValue
        End If

    End If

Next rng

FindFrequency = Array(xOutValue, xMax)

Set dic = Nothing

End Function

Option Explicit
Sub GetContactName()
Dim i As Long, j As Long, sht As Worksheet, lastrow As Long, tempvalue As String

Set sht = ThisWorkbook.ActiveSheet
lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

For i = 2 To lastrow
    For j = 2 To 6
        If Application.WorksheetFunction.CountIf(Range(Cells(i, 2), Cells(i, 6)), Cells(i, j)) > 1 Then
            tempvalue = Cells(i, j)
            Range(Cells(i, 2), Cells(i, 6)).ClearContents
            Cells(i, 2) = tempvalue
        End If
    Next j
Next i

End Sub