Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim sh As Worksheet
Set sh = ActiveWorkbook.Worksheets("ИмяЛиста") ' имя листа сводной таблицы
Set rng = Range("A2:D2")
If Not Intersect(Target, rng) Is Nothing Then
sh.PivotTables("PivotTable1").RefreshTable
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lReply As Long
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B30")) Is Nothing Then
If IsEmpty(Target) Then Exit Sub
If WorksheetFunction.CountIf(Range("B1:B29"), Target) = 0 Then
lReply = MsgBox("Добавить введенное имя " & Target & " в выпадающий список?", vbYesNo + vbQuestion)
If lReply = vbYes Then
If Range("B29") = "" Then
Range("B29") = Target.Value
Else
Range("B" & Range("B30").End(xlUp).Row - 1) = Target
End If
End If
End If
End If
End Sub
Свод данных в одну таблицу с разных листов, Есть ли способ собрать динамическую таблицу сводных данных из нескольких таблиц (листов excel) с разным количеством строк без Power Query
Sub VideoDuration()
Debug.Print GetFileInfo("Путь_к_папке\", "ИмяФайлаСРасширением", 27)
End Sub
Function GetFileInfo(FolderPath As Variant, FileItem As String, PropN As Integer) As String
Dim sFile, ObjDir As Object, Obj
Set ObjDir = CreateObject("Shell.Application").Namespace(FolderPath)
Set sFile = ObjDir.ParseName(FileItem)
Obj = ObjDir.GetDetailsOf(sFile, PropN)
If Obj <> "" Then
Obj = Replace(Obj, ChrW(8206), "")
Obj = Replace(Obj, ChrW(8207), "")
GetFileInfo = Obj
Set ObjDir = Nothing
Exit Function
End If
Set ObjDir = Nothing
End Function
Извлечь НАИМЕНЬШЕЕ по ТРЁМ УСЛОВИЯМ с ЧАСТИЧНЫМ СОВПАДЕНИЕМ в СЕРЕДИНЕ текста из ДВУХ ИСХОДНИКОВ находящихся на РАЗНЫХ ЛИСТАХ (СТРАНИЦАХ). Версия Excel-2013., Извлечь НАИМЕНЬШЕЕ по ТРЁМ УСЛОВИЯМ с ЧАСТИЧНЫМ СОВПАДЕНИЕМ в СЕРЕДИНЕ текста из ДВУХ ИСХОДНИКОВ находящихся на РАЗНЫХ ЛИСТАХ (СТРАНИЦАХ). Версия Excel-2013.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
Dim rng As Range
Set rng = Range("C2:E" & ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row)
If Not Intersect(Target, rng) Is Nothing Then
Str = ActiveCell.Row
Stlb = ActiveCell.Column
Calendar.Show vbModeless
End If
End Sub
Как упорядочить шапку таблиц, если структура столбцов меняется местами в Power Query, Неплоские таблицы и имеют объединение, в шапке меняется порядок столбцов
Sub Hide()
Columns.Hidden = False
Dim cell As Range
Application.ScreenUpdating = False
If ActiveSheet.Range("a1") = "Итого ГК" Then
ActiveSheet.Range("b3:in3").EntireColumn.Hidden = False
Else
For Each cell In ActiveSheet.Range("b3:in3").Cells
If cell.Value = ActiveSheet.Range("a1") Then cell.EntireColumn.Hidden = True
Next
End If
Application.ScreenUpdating = True
End Sub
Запрос на помощь по извлечению данных из файла .docx, Прошу помощи в извлечении и обработке данных из файла .docx, выделенных зеленым и желтым цветом. Требуется улучшение кода для извлечения дополнительной информации. Прилагаю файлы. Спасибо!
Dim wb As Workbook
Application.EnableEvents = False
Set wb = Workbooks.Open("Путь к файлу", False, True)
'Ваш код
Application.EnableEvents = True
wb.Close False
Запрос на помощь по извлечению данных из файла .docx, Прошу помощи в извлечении и обработке данных из файла .docx, выделенных зеленым и желтым цветом. Требуется улучшение кода для извлечения дополнительной информации. Прилагаю файлы. Спасибо!