Страницы: 1
RSS
Автоматизация. Перенос ячеек
 
Добрый день! Есть список (столбцы A и B). Из него нужно получить результат как в столбцах F,G,H. Как этого можно добиться? Пока что справляюсь Ctrl+C и Ctrl+V, но хотелось бы автоматически. [img]data:image/png;base64,iVBORw0KGgo8sHbyK/+Y+jgAAAABJRU5ErkJggg==[/img]
Изменено: БМВ - 06.12.2023 22:14:24
 
Здравствуйте.

1 Способ (выделено желтым). Очень просто формулами.
2 Способ (Лист Таблица2). Тоже просто - Power Query (Добавляете данные в умную таблицу обновляете запрос).
 
Здравствуйте Макросом
Код
Sub enstaraldf()
Dim Rg2  As Range, Rg3 As Range, Rg4 As Range
Application.ScreenUpdating = False
Cells(1).CurrentRegion.Copy Range("G1")
For Each Rg2 In Range("G1").CurrentRegion.Columns(1).Cells
    If VBA.IsDate(Rg2.Value) Then
    Set Rg3 = Rg2
If Rg4 Is Nothing Then Set Rg4 = Rg2.Offset(, -1).Resize(, 3) Else Set Rg4 = Union(Rg2.Offset(, -1).Resize(, 3), Rg4)
    Else: Rg3.Copy Rg2.Offset(, -1)
    End If
Next
Rg4.Delete Shift:=xlUp
Application.ScreenUpdating = True
End Sub
 
Еще вариант с коллекцией
Код
Sub enstaraldпf()
Dim Arr1, Tp1, i&, ZZ As Date, Col1 As New Collection
Arr1 = Cells(1).CurrentRegion
ReDim Tp1(2)
    For i = 1 To UBound(Arr1, 1)
        If VBA.IsDate(Arr1(i, 1)) Then
        ZZ = Arr1(i, 1)
        Else:
        Tp1(0) = ZZ: Tp1(1) = Arr1(i, 1): Tp1(2) = Arr1(i, 2)
        Col1.Add Tp1
        End If
    Next i
ReDim Tp1(1 To Col1.Count, 1 To 3)
    For i = 1 To Col1.Count
        Tp1(i, 1) = Col1(i)(0)
        Tp1(i, 2) = Col1(i)(1)
        Tp1(i, 3) = Col1(i)(2)
    Next
With Range("G1").Resize(Col1.Count)
    .Resize(, 3) = Tp1
    .NumberFormat = "d-mmm"
End With
End Sub
 
День добрый
вариант попроще с допстолбцами
и... чуть посложней
Страницы: 1
Наверх