Sub InsertImagesToCellsRandomOrder()
    Dim ws As Worksheet
    Dim cell As Range
    Dim imagePath As String
    Dim img As Picture
    Dim fileDialog As fileDialog
    Dim filePaths() As String
    Dim i As Integer
    Dim imgAspectRatio As Double
    Dim randomIndex As Integer
    Dim temp As String
    Dim newWidth As Double, newHeight As Double

    ' Используем активный лист
    Set ws = ActiveSheet

    ' Создаем диалог для выбора изображений
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    fileDialog.AllowMultiSelect = True
    fileDialog.Filters.Clear
    fileDialog.Filters.Add "Images", "*.jpg; *.jpeg; *.png; *.bmp; *.gif", 1

    ' Показываем диалог
    If fileDialog.Show = -1 Then
        ' Создаем массив для сохранения выбранных путей изображений
        ReDim filePaths(1 To fileDialog.SelectedItems.Count)
        
        ' Сохраняем выбранные пути изображений в массив
        For i = 1 To fileDialog.SelectedItems.Count
            filePaths(i) = fileDialog.SelectedItems(i)
        Next i

        ' Перемешиваем список файлов (алгоритм Fisher-Yates)
        For i = LBound(filePaths) To UBound(filePaths)
            randomIndex = Int((UBound(filePaths) - LBound(filePaths) + 1) * Rnd + LBound(filePaths))
            temp = filePaths(i)
            filePaths(i) = filePaths(randomIndex)
            filePaths(randomIndex) = temp
        Next i

        ' Вставляем изображения в ячейки
        For i = 1 To UBound(filePaths)
            imagePath = filePaths(i)

            ' Проверяем, есть ли еще ячейки для вставки
            If i > Selection.Cells.Count Then Exit For

            Set cell = Selection.Cells(i)
            Set img = ws.Pictures.Insert(imagePath)

            ' Получаем соотношение сторон изображения
            imgAspectRatio = img.Width / img.Height

            ' Определяем новые размеры
            If imgAspectRatio > 1.1 Then
                ' Портретные изображения (ширина больше высоты)
                img.ShapeRange.LockAspectRatio = msoFalse
                img.ShapeRange.Rotation = 90 ' Поворачиваем изображение
                img.Width = cell.Height - 2 ' Ширина изображения будет равна высоте ячейки
                img.Height = img.Width / imgAspectRatio - 2 ' Высота устанавливается по соотношению
            Else
                ' Альбомные изображения
                If imgAspectRatio >= 0.9 And imgAspectRatio <= 1.1 Then
                    ' Если изображение почти квадратное, устанавливаем одинаковые размеры
                    img.Width = cell.Width - 4
                    img.Height = img.Width - 5 ' Устанавливаем высоту равной ширине
                Else
                    If imgAspectRatio > 1 Then
                        img.Width = cell.Width - 2
                        img.Height = img.Width / imgAspectRatio - 2
                    Else
                        img.Height = cell.Height - 2
                        img.Width = img.Height * imgAspectRatio - 2
                    End If
                End If
            End If

            ' Центрируем изображение в ячейке
            img.Top = cell.Top + (cell.Height - img.Height) / 2
            img.Left = cell.Left + (cell.Width - img.Width) / 2
        Next i
    End If
End Sub

Sub InsertImagesToCellsRandomOrder()
    Dim ws As Worksheet
    Dim cell As Range
    Dim imagePath As String
    Dim img As Picture
    Dim fileDialog As fileDialog
    Dim filePaths() As String
    Dim i As Integer
    Dim imgAspectRatio As Double
    Dim cellAspectRatio As Double
    Dim randomIndex As Integer
    Dim temp As String

    ' Укажите лист Excel
    Set ws = ThisWorkbook.ActiveSheet ' Укажите название листа

    ' Создаем диалог для выбора изображений
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    fileDialog.AllowMultiSelect = True
    fileDialog.Filters.Clear
    fileDialog.Filters.Add "Images", "*.jpg; *.jpeg; *.png; *.bmp; *.gif", 1

    ' Показываем диалог
    If fileDialog.Show = -1 Then
        ' Создаем массив для сохранения выбранных путей изображений
        ReDim filePaths(1 To fileDialog.SelectedItems.Count)
        
        ' Сохраняем выбранные пути изображений в массив
        For i = 1 To fileDialog.SelectedItems.Count
            filePaths(i) = fileDialog.SelectedItems(i)
        Next i

        ' Перемешиваем список файлов (алгоритм Fisher-Yates)
        For i = LBound(filePaths) To UBound(filePaths)
            randomIndex = Int((UBound(filePaths) - LBound(filePaths) + 1) * Rnd + LBound(filePaths))
            temp = filePaths(i)
            filePaths(i) = filePaths(randomIndex)
            filePaths(randomIndex) = temp
        Next i

        ' Вставляем изображения в ячейки
        For i = 1 To UBound(filePaths)
            imagePath = filePaths(i)

            ' Проверяем, есть ли еще ячейки для вставки
            If i > Selection.Cells.Count Then Exit For

            Set cell = Selection.Cells(i)
            Set img = ws.Pictures.Insert(imagePath)

            ' Получаем размеры и пропорции
            imgAspectRatio = img.Width / img.Height
            cellAspectRatio = cell.Width / cell.Height

            ' Масштабируем изображение, сохраняя пропорции
            If imgAspectRatio > cellAspectRatio Then
                img.Width = cell.Width - 1
                img.Height = img.Width / imgAspectRatio - 1
            Else
                img.Height = cell.Height - 1
                img.Width = img.Height * imgAspectRatio - 1
            End If

            ' Центрируем изображение в ячейке
            img.Top = cell.Top + (cell.Height - img.Height) / 2
            img.Left = cell.Left + (cell.Width - img.Width) / 2
        Next i
    End If
End Sub

Sub InsertImagesToCells()
    Dim ws As Worksheet
    Dim cell As Range
    Dim imagePath As String
    Dim img As Picture
    Dim fileDialog As fileDialog
    Dim filePaths As Variant
    Dim i As Integer
    Dim imgAspectRatio As Double
    Dim cellAspectRatio As Double

    ' Укажите лист Excel
    Set ws = ThisWorkbook.ActiveSheet ' Укажите название листа

    ' Создаем диалог для выбора изображений
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    fileDialog.AllowMultiSelect = True
    fileDialog.Filters.Clear
    fileDialog.Filters.Add "Images", "*.jpg; *.jpeg; *.png; *.bmp; *.gif", 1

    ' Показываем диалог
    If fileDialog.Show = -1 Then
        ' Сохраняем выбранные пути изображений
        For i = 1 To fileDialog.SelectedItems.Count
            imagePath = fileDialog.SelectedItems(i)

            ' Проверяем, есть ли еще ячейки для вставки
            If i > Selection.Cells.Count Then Exit For

            Set cell = Selection.Cells(i)
            Set img = ws.Pictures.Insert(imagePath)

            ' Получаем размеры и пропорции
            imgAspectRatio = img.Width / img.Height
            cellAspectRatio = cell.Width / cell.Height

            ' Масштабируем изображение, сохраняя пропорции
            If imgAspectRatio > cellAspectRatio Then
                img.Width = cell.Width - 1
                img.Height = img.Width / imgAspectRatio - 1
            Else
                img.Height = cell.Height
                img.Width = img.Height * imgAspectRatio
            End If

            ' Центрируем изображение в ячейке
            img.Top = cell.Top + (cell.Height - img.Height) / 2
            img.Left = cell.Left + (cell.Width - img.Width) / 2
        Next i
    End If
End Sub

=СУММПРОИЗВ(($A$1:$A$29=A1)*1)

let
    Source = Excel.CurrentWorkbook()
{[Name="emails"]}[Content], FirstRow=Source{0}
[Column1],
SplitText=Text.Split(FirstRow, ", "),
ResultTable=Table.FromList(SplitText,Splitter.SplitByNothing(),{"Column1"})
in
    ResultTable

' Предположим, что нужно получить первый элемент из выборки
Set firstElement = xmlSelect.Item(0)

' Теперь можно работать с атрибутами этого элемента
Dim attributeValue
attributeValue = firstElement.getAttribute("yourAttributeName")

' Вывод значения атрибута
MsgBox attributeValue

Sub Макрос1()
    Range(Split(Range("I9").Formula, "=")(1)).ClearContents
End Sub

Sub shishalmyshal()
    Dim LastRow As Integer
    Dim i As Integer
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    i = 4
    Do
        If Cells(i, 3) > 1 Then
            Rows(i + 1 & ":" & i + Cells(i, 3) - 1).Insert Shift:=xlDown
            Rows(i & ":" & i + Cells(i, 3) - 1).FillDown
            i = i + Cells(i, 3) - 1
            LastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
        End If
        i = i + 1
    Loop While i < LastRow
End Sub

Sub HighlightDuplicates()
    Dim i As Integer

    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If Application.WorksheetFunction.CountIf(Range("A1:A" & i), Cells(i, 1).Value) > 1 And Cells(i, 1).Value <> "" Then
            Cells(i, 2).Value = "дубль"
        End If
    Next i
    
End Sub