сколько? точно, в граммах По поводу размера бумаги. Ставьте любой виртуальный принтер, выбираете его по умолчанию, создаете в настройках нужный формат бумаги. После этого в excel можно выбрать созданный формат в качестве размера листа и не нужно будет считать строки.
в файл добавил 2 именованных диапазона [vba]
Код
Sub QWE() Dim dic, cell As Range, arr, k& Set dic = CreateObject("scripting.dictionary") For Each cell In [города] dic.Add [список].Find(cell).Row, cell.Value Next arr = dic.keys For k = 1 To UBound(arr) Me.HPageBreaks.Add before:=Range("список")(arr(k)) Next Set dic = Nothing End Sub
сколько? точно, в граммах По поводу размера бумаги. Ставьте любой виртуальный принтер, выбираете его по умолчанию, создаете в настройках нужный формат бумаги. После этого в excel можно выбрать созданный формат в качестве размера листа и не нужно будет считать строки.
в файл добавил 2 именованных диапазона [vba]
Код
Sub QWE() Dim dic, cell As Range, arr, k& Set dic = CreateObject("scripting.dictionary") For Each cell In [города] dic.Add [список].Find(cell).Row, cell.Value Next arr = dic.keys For k = 1 To UBound(arr) Me.HPageBreaks.Add before:=Range("список")(arr(k)) Next Set dic = Nothing End Sub
Set fso = CreateObject("Scripting.FileSystemObject") Set fld = fso.GetFolder(ThisWorkbook.Path) Set ss = New Collection Set ss = fld.Files For Each ff In ss Debug.Print ff.Name Next
[/vba], чем черт не шутит, вдруг сработает
а еси так [vba]
Код
Set fso = CreateObject("Scripting.FileSystemObject") Set fld = fso.GetFolder(ThisWorkbook.Path) Set ss = New Collection Set ss = fld.Files For Each ff In ss Debug.Print ff.Name Next
[/vba], чем черт не шутит, вдруг сработаетkrosav4ig
Function qwe(rng As Range, r&) Application.Volatile False Dim cell As Range, i&, j, n&, arr&() For Each cell In rng If IsNumeric(cell) Then ReDim Preserve arr(i) arr(i) = cell i = i + 1 Else If InStr(cell, "-") Then For j = Split(cell, "-")(0) To Split(cell, "-")(1) ReDim Preserve arr(i) arr(i) = j i = i + 1 Next End If End If Next qwe = arr(r - 1) End Function
[/vba]
[vba]
Код
Function qwe(rng As Range, r&) Application.Volatile False Dim cell As Range, i&, j, n&, arr&() For Each cell In rng If IsNumeric(cell) Then ReDim Preserve arr(i) arr(i) = cell i = i + 1 Else If InStr(cell, "-") Then For j = Split(cell, "-")(0) To Split(cell, "-")(1) ReDim Preserve arr(i) arr(i) = j i = i + 1 Next End If End If Next qwe = arr(r - 1) End Function
если нужно работать с листами к примеру с листами с 3 по 10 то код будет такой [vba]
Код
Private Sub Workbook_SheetSelectionChange1(ByVal sh As Object, ByVal Target As Range) With Application: .ScreenUpdating = 0: .EnableEvents = 0: End With Dim f&, l&, arr() f = 3: l = 10 If sh.Index <= l And sh.Index >= f Then If Not Intersect([B5:B30], Target) Is Nothing And GetAsyncKeyState(18) Then arr = Application.Transpose(Evaluate("=row(" & f & ":" & l & ")")) Sheets(arr).Select: sh.Activate: Target.Select Else sh.Select End If End If With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With End Sub
[/vba] если со всеми листами то нужен 1 лишний лист в конце книги и код такой [vba]
Код
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range) With Application: .ScreenUpdating = 0: .EnableEvents = 0: End With Dim arr() If Not Intersect([B5:B30], Target) Is Nothing And GetAsyncKeyState(18) Then arr = Application.Transpose(Evaluate("=row(1:" & Sheets.Count - 1 & ")")) Sheets(arr).Select: sh.Activate: Target.Select Else sh.Select End If With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With End Sub
[/vba]
если нужно работать с листами к примеру с листами с 3 по 10 то код будет такой [vba]
Код
Private Sub Workbook_SheetSelectionChange1(ByVal sh As Object, ByVal Target As Range) With Application: .ScreenUpdating = 0: .EnableEvents = 0: End With Dim f&, l&, arr() f = 3: l = 10 If sh.Index <= l And sh.Index >= f Then If Not Intersect([B5:B30], Target) Is Nothing And GetAsyncKeyState(18) Then arr = Application.Transpose(Evaluate("=row(" & f & ":" & l & ")")) Sheets(arr).Select: sh.Activate: Target.Select Else sh.Select End If End If With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With End Sub
[/vba] если со всеми листами то нужен 1 лишний лист в конце книги и код такой [vba]
Код
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range) With Application: .ScreenUpdating = 0: .EnableEvents = 0: End With Dim arr() If Not Intersect([B5:B30], Target) Is Nothing And GetAsyncKeyState(18) Then arr = Application.Transpose(Evaluate("=row(1:" & Sheets.Count - 1 & ")")) Sheets(arr).Select: sh.Activate: Target.Select Else sh.Select End If With Application: .ScreenUpdating = 1: .EnableEvents = 1: End With End Sub
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Not Intersect([B5:B30], Target) Is Nothing And GetAsyncKeyState(18) Then Sheets(Array("Лист1", "Лист2", "Лист3")).Select Else ActiveSheet.Select End If End Sub
[/vba] при выборе любой ячейки или диапазона из B5:B30 с зажатым alt вносимые изменения будут отображаться на всех 3-х листах
[vba]
Код
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Not Intersect([B5:B30], Target) Is Nothing And GetAsyncKeyState(18) Then Sheets(Array("Лист1", "Лист2", "Лист3")).Select Else ActiveSheet.Select End If End Sub
[/vba] при выборе любой ячейки или диапазона из B5:B30 с зажатым alt вносимые изменения будут отображаться на всех 3-х листахkrosav4ig
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
А пока подсказка: СЧЁТЕСЛИМН()[offtop]опять опоздал )
