VB-код для проверки соответствия текста ячейке

Я строю инструмент на excel, мне нужно проверить, подходит ли текст к ячейке, если нет, я должен объединить ячейки, чтобы соответствовать тексту. ячейки исправлены я не могу использовать autofit или опцию.
Пожалуйста предложите код ВБ, спасибо заранее

1 ответ

  1. Ответили в другом месте, но это основной код, который работает. Autosize.

    Sub merger()
    Set c = ActiveSheet.Range("A:A").Find(what:="Executive Weekly Summary")
    If Not c Is Nothing Then
    startrow = c.Row + 1
    endrow = ActiveSheet.Range("A" & startrow).End(xlDown).Row - 1
    End If
      '"A" & startrow & ":I" & endrow
    OldWidth = ActiveSheet.Range("A" & startrow & ":A" & endrow).ColumnWidth ' Save original width
    
    ActiveSheet.Range("A" & startrow & ":A" & endrow).EntireColumn.AutoFit
    fitwidth = ActiveSheet.Range("A:A").ColumnWidth ' Get width required to fit entire text
    
    ActiveSheet.Range("A" & startrow & ":A" & endrow).ColumnWidth = OldWidth ' Restore original width
    
    If OldWidth < fitwidth Then
    Do Until OldWidth = fitwidth
        ActiveSheet.Range("").Merge
        endrow = endrow + 1
    
        OldWidth = ActiveSheet.Range("A" & startrow & ":A" & endrow).ColumnWidth
    ActiveSheet.Range("A" & startrow & ":A" & endrow).EntireColumn.AutoFit
    fitwidth = ActiveSheet.Range("A:A").ColumnWidth
    ActiveSheet.Range("A" & startrow & ":A" & endrow).ColumnWidth = OldWidth
    Loop
    End If
    End Sub