Справка - Поиск - Участники - Войти - Регистрация
Полная версия: Вопрос по Excel
Частный клуб Алекса Экслера > Софт
Страницы: 1, 2
alibek
5 октября 2016, 15:07
У меня есть таблица Excel с такими данными:
CODE

Улица        Номер  Люди
-----------  -----  ----
Абрикосовая  1      5
Абрикосовая  3      3
Абрикосовая  5      2
Виноградная  11     2
Тенистая     4      1
Тенистая     10     1

Мне нужно получить из этой таблицы что-то такое:
CODE

Улица        Кол-во  Сумма  Номера
-----------  ------  -----  -------
Абрикосовая  3       10     1, 3, 5
Виноградная  1       2      11
Тенистая     2       2      4, 10

Интересует колонка "Номера", есть ли такое в сводных таблицах?
cloud
5 октября 2016, 16:15
В сводной таблице так не выйдет. Если данных немного, то бы я сцепила номера через запятую.
Улицы с суммой жильцов отдельно, а номера отдельно.
alibek
5 октября 2016, 18:10
Сцепить — имеется ввиду обычные формулы Excel или макросы?
Нет, я хотел именно функциями сводной таблицы это сделать.
Ну раз нет, то нет.
cloud
6 октября 2016, 15:13

alibek написал: Сцепить — имеется ввиду обычные формулы Excel или макросы?

Функцией "сцепить". В сводной такое не получится.
Alx
7 октября 2016, 21:18

alibek написал: Интересует колонка "Номера", есть ли такое в сводных таблицах?

А зачем сводная? Для колонки "Кол-во" используй функцию СЧЕТЕСЛИМН, для "Сумма" - СУММЕСЛИМН.
alibek
8 октября 2016, 12:39
Потому что мне нужна именно сводная таблица, с всеми четырьмя колонками (Улица, Количество, Сумма, Номера).
Составить список улиц еще можно, но Номера с помощью формул Excel не сделать (Excel 2007, функция СЦЕПИТЬ не принимает диапазон ячеек).
Alx
8 октября 2016, 15:03
Я сделал файл по твоей задаче. Без сводных таблиц. Условие только одно: в исходной таблице улицы должны быть отсортированы по алфавиту, это тоже можно учесть, но я не стал. Если исходных данных много, то будет жрать ресурсы.
Скажи куда кинуть.
Okeanolog
25 октября 2016, 17:52
Человеку присылают таблицу следующего вида.

Нужно сделать фильтр по, например, первому параметру (место) и раскидать по листам. Т.е. чтобы на втором листе были все строки, которые относятся к Москве, на третьем - Тула, на 4-м - Орел и т.д. Города всегда одни и те же.
Сейчас делают фильтры, выводят, например, только Москву и затем копи-паст на нужный лист. Но городов там много, таблица здоровая и руками делать долго и муторно. Можно это как-то оптимизировать? Не знаю, может макрос какой-то... Чтобы кнопку нажал и все раскидалось по нужным листам.
Alex Lonewolf
25 октября 2016, 18:18

Okeanolog написал: Человеку присылают таблицу следующего вида.

Нужно сделать фильтр по, например, первому параметру (место) и раскидать по листам. Т.е. чтобы на втором листе были все строки, которые относятся к Москве, на третьем - Тула, на 4-м - Орел и т.д. Города всегда одни и те же.
Сейчас делают фильтры, выводят, например, только Москву и затем копи-паст на нужный лист. Но городов там много, таблица здоровая и руками делать долго и муторно. Можно это как-то оптимизировать? Не знаю, может макрос какой-то... Чтобы кнопку нажал и все раскидалось по нужным листам.

Хм... А в списке могут появляться новые города для которых раньше не создавались листы? Или напротив если некоторый город выбыл, то следует ли сохранять за ним пустые листы, или сократить число листов соответственно?

Если бы передо мною сейчас стояла такая задача, то я бы её решал путем написания небольшой программы с использованием ну хоть бы и MS-овских API для офисных форматов.

Если бы требовалось решить исключительно в рамках Excel, то пожалуй я бы написал макрос объединяющий операцию выбора следующего из списка фильтрации, создание нового листа и копирование результата фильтрации на него. Т.е. для 50 городов потребовалось бы 50 раз нажать кнопку макроса.
Правда я не уверен, можно ли в макросах создавать новые листы, никогда не возникало такой потребности. Но, скорее всего, можно.
Okeanolog
25 октября 2016, 18:42

Alex Lonewolf написал: А в списке могут появляться новые города для которых раньше не создавались листы?

Нет, я же написал:

Okeanolog написал: Города всегда одни и те же.

Alex Lonewolf
25 октября 2016, 19:11
Тогда несколько проще. Можно с помощью функций категории "ссылки и массивы" создать на листе конкретного города ряд формул, которые будут выбирать нужные строки из данных помещенных (скопированных) на первый лист. Данные на первом листе желательно иметь отсортированными по городам.
Носки Поэта
25 октября 2016, 19:59

Okeanolog написал: Чтобы кнопку нажал и все раскидалось по нужным листам.

Внешний wsh скрипт устроит?
alibek
25 октября 2016, 23:35

Okeanolog написал: Нужно сделать фильтр по, например, первому параметру (место) и раскидать по листам.

А что затем с этими листами делается?
Если просто просмотр/печать, то в той же сводной таблице при двойном клике на группе автоматически создается новый лист со строками этой группы.
Носки Поэта
26 октября 2016, 19:29

Okeanolog написал: Можно это как-то оптимизировать? Не знаю, может макрос какой-то... Чтобы кнопку нажал и все раскидалось по нужным листам.

Вот простенький скрипт:
CODE
Option explicit
Dim Excel, xBook

'Ищем лист с именем нужного города. Если не находим - добавляем в конец.
' и возвращаем номер нужного листа
Function FindSheet(CityName)
 Dim j
 j = 0
 if not IsEmpty(Cityname) then
   for j = 2 to xBook.Sheets.Count Step 1
     if Trim(UCase(xBook.Sheets(j).Name)) = Trim(UCase(CityName)) Then
       Exit For
     end if
   next
   if (j > xBook.Sheets.Count) Then
     xBook.Sheets.Add , xBook.Sheets(xBook.Sheets.Count)
     xBook.Sheets(xBook.Sheets.Count).Name = CityName
   end if
 end if
 FindSheet = j
end Function

'Собственно подпрограмма, обрабатывающая экселевский файл

Sub Wrk(xArg)
 Dim  xSheet1, xSheetN, i, j, N, xCity
 Set xBook = Excel.Workbooks.open(xArg)

' Если в файле больше одного листа
' удаляем из файла все листы кроме первого
' если не надо, то этот кусок можно удалить

 if xBook.Sheets.Count > 1 Then
   for i = xBook.Sheets.Count to 2 Step -1
     xBook.Sheets(i).delete
   next
 end if

' начинаем обработку первого листа

 Set xSheet1 = xBook.Sheets(1)
 i = 2 'строка начала собственно данных

' читаем в цикле все ячейки столбца A, пока не встретится пустая

 Do until isEmpty(xSheet1.Range("A" & Cstr(i)).Value)
   xCity = Trim(xSheet1.Range("A" & Cstr(i)).Value)
   N = FindSheet(Cstr(xCity))
   Set xSheetN = xBook.Sheets(N)

' Ищем первую пустую строку в найденном листе - будем вставлять туда

   N = 1
   Do until IsEmpty(xSheetN.Range("A" & Cstr(N)).Value)
     N = N + 1
   Loop

' Вставляем значения из ячеек текущей строки первого листа
' в соответствующие ячейки найденной пустой строки листа с названием как у города

   j = 1
   Do until IsEmpty(xSheet1.Cells(i,j).Value)
     xSheetN.Cells(N,j).Value = xSheet1.Cells(i,j).Value
     j = j + 1
   Loop
   i = i + 1
 Loop
 xBook.Save
 xBook.Close
End Sub
' А это просто программа, которая всем руководит

sub mainWrk
 Dim oArgs, i

' Считываем аргументы переданные при запуске
' Можно запускать её как старый добрый bat-файл с параметрами,
' в которых перечислять полные пути к excel файлам
' А можно повесить на рабочий стол ярлык,
' и если бросить на этот ярлык один или несколько excel-файлов
' они все обработаются и сохранятся там же, где и были !!! :)

 Set oArgs = WScript.Arguments
 If oArgs.Count > 0 Then
   For i = 0 to oArgs.Count - 1
     call wrk(oArgs(i))
   Next
 end If
end sub

 Set Excel = CreateObject("Excel.Application")

 Excel.visible = False
 call mainWrk


'  call wrk("F:\wsh\xls1.xlsx")

Пояснения.
  1. Код выделить и сохранить в файл с расширением .vbs
  2. Повесить на рабочий стол ярлык, ведущий к этому файлу
  3. Excel-файлы, предварительно закрыв, бросать непосредственно на ярлык.
  4. Потом смотреть, что получилось в исходных файлах. Если есть желание видеть всё в процессе, и не сохранять изменений, пока не убедишьсянадо заменить сроку Excel.visible = False на Excel.visible = True. И поставить апостроф в начале строк
' xBook.Save
' xBook.Close
Носки Поэта
3 ноября 2016, 15:11
Для того, чтобы копировалась вся строка, независимо от длины, с переносом форматирования, попробуй заменить
CODE

' Вставляем значения из ячеек текущей строки первого листа
' в соответствующие ячейки найденной пустой строки листа с названием как у города

  j = 1
   Do until IsEmpty(xSheet1.Cells(i,j).Value)
     xSheetN.Cells(N,j).Value = xSheet1.Cells(i,j).Value
     j = j + 1
   Loop

на
CODE

' копируем целиком i строку с первой страницы в N строку найденной страницы
' с переносом форматирования

   xSheet1.Rows(i).copy
   xSheetN.Paste xSheetN.Rows(N)
me45
3 ноября 2016, 17:40
Подскажите - назрело 2 вопроса
1) Есть столбец с телефонными номерами, и есть столбец с датой в одинаковом формате. Нужно каким-то образом выделить номера, которые в этом списке оказались в первый раз за период.
2) Есть прайс лист, с 2-х этажной структурой, (категория-подкатегория) между ними пустые строки.
Как можно сделать сортировку по цене (возрастание/убывание), чтобы аналогично поменялись местами смежные с ценой ячейки (наименование)
Носки Поэта
3 ноября 2016, 18:10

me45 написал: Подскажите - назрело 2 вопроса

Внешним VBS-скриптом можно, как и предыдущее решение, или обязательно встроенными в сам Excel средствами?
Носки Поэта
3 ноября 2016, 18:20

me45 написал: 1) Есть столбец с телефонными номерами, и есть столбец с датой в одинаковом формате. Нужно каким-то образом выделить номера, которые в этом списке оказались в первый раз за период.

1. Я правильно понимаю, что надо как-то подсветить, выделить цветом те строчки, в которых дата, стоящая напротив номера, является минимальной среди всех встреченных записей с данным номером на исследуемом листе?
2. Положение столбца с номером и с датой заранее определено, или строго как попало и их надо определять по формату ячеек?

me45 написал: 2) Есть прайс лист, с 2-х этажной структурой, (категория-подкатегория) между ними пустые строки.Как можно сделать сортировку по цене (возрастание/убывание), чтобы аналогично поменялись местами смежные с ценой ячейки (наименование) 

Как определить, что в данной ячейке именно цена? В этом столбце в смежных строках совсем нет информации? Или - может и быть, но она нечисловая?
me45
3 ноября 2016, 18:57

Носки Поэта написал:
1. Я правильно понимаю, что надо как-то подсветить, выделить цветом те строчки, в которых дата, стоящая напротив номера, является минимальной среди всех встреченных записей с данным номером на исследуемом листе?

2. Положение столбца с номером и с датой заранее определено, или строго как попало и их надо определять по формату ячеек?

Скажу по другому - есть лог звонков, надо найти номера, с которых нам звонили в первый раз (количество этих номеров)



Как определить, что в данной ячейке именно цена? В этом столбце в смежных строках совсем нет информации? Или - может и быть, но она нечисловая?

Вот как-то так
Как вариант, оставить ячейки определенной цены (например, больше 1000)
Носки Поэта
3 ноября 2016, 19:12

me45 написал: Скажу по другому - есть лог звонков, надо найти номера, с которых нам звонили в первый раз (количество этих номеров)

Тогда ещё уточнение. Этот excel-евский файл содержит более широкий период, чем тебе надо выбирать? И, соответственно, рамки периода в который ты ищешь телефоны неофитов, у пользователя надо как-то запросить, или найти их в файле? И, имея временные рамки, найти в файле начало этого периода, а затем бежать вниз и искать не было ли вхождений очередного телефона выше по файлу?
Или всё же весь файл представляет искомый период, и надо просто составить этот же список, только без повторений на новом листе или в новом файле?
me45
3 ноября 2016, 19:15

Носки Поэта написал:
Тогда ещё уточнение. Этот excel-евский файл содержит более широкий период, чем тебе надо выбирать? И, соответственно, рамки периода в который ты ищешь телефоны неофитов, у пользователя надо как-то запросить, или найти их в файле? Или же весь файл представляет искомый период, и надо просто составить этот же список, только без повторений на новом листе или в новом файле?

С периодом хороший вопрос.
Я думал - как определить , что звонок в первый раз? Гарантированно никак, потому что он мог быть первый раз за месяц, но третий за 2 месяца.
Поэтому, наверное, остается вариант с погрешностью - то есть, если в выгруженном периоде номер встречается 1 раз - будем считать его новым.
Носки Поэта
3 ноября 2016, 19:20

me45 написал: Гарантированно никак, потому что он мог быть первый раз за месяц, но третий за 2 месяца.

Если есть другие файлы - кто мешает внешнему скрипту переключаться между ними? Определить какие ещё файлы включать в рассмотрение на основании информации из данного файла, или из его названия, или из пути как-то можно? Есть же какая-то логика в размещении на хранение и есть какая-то разумная глубина копания.
Носки Поэта
3 ноября 2016, 19:25

me45 написал: Поэтому, наверное, остается вариант с погрешностью - то есть, если в выгруженном периоде номер встречается 1 раз - будем считать его новым. 

Можно даже разбить задачу на два этапа:
1. Выгрузка всех уников из данного файла в новый промежуточный файл.
2. Сравнение записей из полученного файла со старыми архивами уников, которые уже обработаны данным скриптом. Соответственно старые архивы за разумное время предварительно обработать в нужной последовательности.
Носки Поэта
3 ноября 2016, 19:30
Ок. Если никто больше не возьмётся, я постараюсь в понедельник написать - вроде всё элементарно выглядит пока. Дома офиса нет, так что отладить не получится.
Носки Поэта
7 ноября 2016, 17:00

me45 написал: 1) Есть столбец с телефонными номерами, и есть столбец с датой в одинаковом формате. Нужно каким-то образом выделить номера, которые в этом списке оказались в первый раз за период.

Код выделить и сохранить в файл с расширением .vbs

Прога проверяет наличие файлов в папке F:\ME45. Из каждого найденного файла с расширением xlsx предварительно извлекаются все уникальные записи в столбце А, затем исходный файл закрывается и переносится переносит в F:\ME45\ARHIVE, а полученный файл уников сверяется с ранее сохраненными аналогичными файлами уников в папке F:\ME45\UNIQ и встретившиеся записи удаляются из полученного файла. Покоцанный таким образом файл (может даже и пустой) сохраняется в папке F:\ME45\UNIQ\ с именем, в котором к исходному имени добавлено "-uniq"
Сами папки перечисляются при вызове процедуры wrk (см. последнюю строку кода) и легко меняются. При необходимости можно сделать несколько вызовов wrk с разными тройками папок, чтоб обрабатывать логи для разных телефонов или станций. Можно повесить этот скрипт в шедулер и он будет срабатывать в заданные периоды (например по ночам, если задать) когда в одной или нескольких из рабочих папок появятся файлы.

CODE

Option Explicit
Dim oFSO ' объект для работы с файловой системой
Dim Excel  ' объект для работы с Excel

'Процедура читает файл с именем fPath и создает файл
' с уникальными для данного файла телефонами
' который потом сохраняет в uDir, добавив к исходному имени "-uniq"
'
Sub MakeUniq(fPath, uDir)
Dim iBook, uBook, iSheet, uSheet, i, j, jMax, Phone
Dim oDir, oFile

Set iBook = Excel.Workbooks.open(fPath)          
set uBook = Excel.Workbooks.Add
Set iSheet = iBook.Sheets(1)
Set uSheet = uBook.Sheets(1)
i = 1 'строка начала собственно данных, Если есть строка заголовков - скорректировать
jMax = 0 'изначально в новом файле пустой список уников


' читаем в цикле все ячейки столбца A, пока не встретится пустая
Do until isEmpty(iSheet.Range("A" & Cstr(i)).Value)
  Phone = Trim(iSheet.Range("A" & Cstr(i)).Value)
  For j=1 To Jmax Step 1
    If Trim(uSheet.Range("A" & Cstr(j)).Value) = Phone Then Exit For
  Next
  if j > jMax Then '  если не нашли телефон среди ранее записанных уников
   jMax = jMax+1
   uSheet.Range("A" & Cstr(jMax)).Value = Phone
  end if
  i = i + 1
Loop
iBook.Close ' закрываем исходный файл
iSheet = null
iBook = null

' После того, как все уники из исходного файла перенесены в новый,
' проверим наличие этих уников в предыдущих файлах, лежащих в папке uDIR

Set oDir = oFSO.GetFolder(uDir)
For Each oFile in oDir.Files
  If oFSO.GetExtensionName(oFile.Path) = "xlsx" Then
    Set iBook = Excel.Workbooks.open(oFile.Path)          
    Set iSheet = iBook.Sheets(1)
    For j = jMax to 1 Step -1
      Phone = Trim(uSheet.Range("A" & Cstr(j)).Value)
      Set i = iSheet.Range("A:A").Find(Phone)
      If not i Is Nothing Then
        uSheet.Rows(j).Delete
        jMax = jMax - 1
      End If
    Next
    iBook.Close
    iBook = null
    iSheet = null
  End If
Next
uBook.SaveAs oFSO.BuildPath(uDir, oFSO.GetBaseName(fPath) & "-uniq." & oFSO.GetExtensionName(fPath))

Excel.visible = False

uBook.Close
uBook = null
end sub

' Основная процедура. Просматривает файлы в рабочей папке,
' и если находит файлы с расширением xlsx - передает их
' по очереди на обработку в процедуру MakeUniq,
' затем перебрасывает отработанный исходный файл в архив

sub Wrk(WrkDir, UniqDir, ArhDir)
Dim oDir, oFile 'объекты для работы с папками и файлами

If NOT oFSO.FolderExists( UniqDir) Then oFSO.CreateFolder(UniqDir)
If NOT oFSO.FolderExists( ArhDir) Then oFSO.CreateFolder(ArhDir)


Set oDir = oFSO.GetFolder(WrkDir)
for each oFile in oDir.Files
  If oFSO.GetExtensionName(oFile.Path) = "xlsx" Then 'Защита от случайных файлов
    Call MakeUniq(oFile.Path, UniqDir)
    oFile.Move(ArhDir) ' переносим исходник в архив
  End If
next
end sub

' Это собственно программа

 Set oFSO = CreateObject("Scripting.FileSystemObject")
 Set Excel = CreateObject("Excel.Application")
 
 Excel.visible = True 'Для отладки. Потом лучше поставить False

'Передаем основной процедуре рабочую папку, папку уников и папку для архивирования исходных файлов
 wrk "F:\ME45\", "F:\ME45\UNIQ\", "F:\ME45\ARHIVE\"  
me45
7 ноября 2016, 17:16
Ого, спасибо! Как могу отблагодарить?
Носки Поэта
7 ноября 2016, 17:20

me45 написал: Как могу отблагодарить? 

Не надо. Я просто сам сейчас как раз разбираюсь с WSH и задачи на удивление близки к моим. Взгляд с близкого, но чуть смещённого угла очень помогает оптимизировать код.
me45
7 ноября 2016, 17:22
А вопрос по сортировке цены в прайсе - не решаемый? frown.gif

И еще вопрос, но мне кажется, в формате экселя слишком трудозатратен.
Есть несколько файлов XLS, это прайсы. Можно ли скормить их какой-нибудь обработке, чтобы я вводил наименование товара, а мне показывалась строчка, где в одном из столбцов есть максимальное совпадение с вводимой информацией - соответственно, с ценами и т.д.
Проблема в том, что формат названий изделий сильно разный, нужно будет "склеивать" вводимую информацию.

Для примера, товар ABC-3445-34-20-шарик черный, диметром 20мм хотелось бы найти по запросу "344534" (без тире)
Носки Поэта
7 ноября 2016, 17:28

me45 написал: А вопрос по сортировке цены в прайсе - не решаемый?

Он проще, но с моими задачам не коррелируется. Вечерком будет время - набросаю дома, а завтра отлажу в течение дня или вечером. Или выложу неотлаженное, чтоб сам помучился.

Вопрос по прайсу:
1. сортировка нужна сквозная с выбрасыванием верхней категории?

Или

2. сквозная, но с переносом верхней категории в строку каждой подкатегории?

или

3. сортировка подкатегорий внутри каждой категории, с сохранением местоположений структуры верхнего уровня?
Носки Поэта
7 ноября 2016, 17:30

me45 написал: И еще вопрос, но мне кажется, в формате экселя слишком трудозатратен.Есть несколько файлов XLS, это прайсы.  Можно ли скормить их какой-нибудь обработке, чтобы я вводил наименование товара, а мне показывалась строчка, где в одном из столбцов есть максимальное совпадение с вводимой информацией - соответственно, с ценами и т.д.Проблема в том, что формат названий изделий сильно разный, нужно будет "склеивать" вводимую информацию.

Пока не понял задачу. Попробую вечером вдумчивее почитать.
me45
7 ноября 2016, 17:32

Носки Поэта написал:
Он проще, но с моими задачам не коррелируется. Вечерком будет время - набросаю дома, а завтра отлажу в течение дня или вечером. Или выложу неотлаженное, чтоб сам помучился.

Вопрос по прайсу:
1. сортировка нужна сквозная с выбрасыванием верхней категории?

Или

2. сквозная, но с переносом верхней категории в строку каждой подкатегории?

или

3. сортировка подкатегорий внутри каждой категории, с сохранением местоположений структуры верхнего уровня?

Можно вообще убрать категории (и подкатегории) - вручную, я могу это сделать.
Мне нужно просто сортировка по убывающей цене, чтобы было видно название товара и его цена. Остальная структура - вообще не важна.
Носки Поэта
7 ноября 2016, 17:32

me45 написал: Для примера, товар ABC-3445-34-20-шарик черный, диметром 20мм хотелось бы найти по запросу "344534"  (без тире) 

Как раз в WSH скрипте это сделать легче лёгкого - можно искать по маске, использовать regexp'ы и прочую приятную шнягу.
me45
7 ноября 2016, 17:33

Носки Поэта написал:
Пока не понял задачу. Попробую вечером вдумчивее почитать.

представь поиск на сайте, но в формате экселя, где вместо онлайн каталога товаров - набор прайсов в xls
Носки Поэта
7 ноября 2016, 17:34

me45 написал: Можно вообще убрать категории (и подкатегории) - вручную, я могу это сделать.

Не нужно. Всё же интересней сделать обработку их наличия.
Носки Поэта
7 ноября 2016, 17:35

me45 написал: представь поиск на сайте, но в формате экселя, где вместо онлайн каталога товаров - набор прайсов в xls 

ОК. Подумаю, что можно сделать.
me45
7 ноября 2016, 17:50

Носки Поэта написал:
ОК. Подумаю, что можно сделать.

Спасибо. Если что - формат этих прайсов- самый разный.
Okeanolog
7 ноября 2016, 18:20
Носки Поэта, вот эту верхнюю строку с фильтрами перенести бы. Или применить его на вновь созданных страницах.
Носки Поэта
7 ноября 2016, 19:58

Okeanolog написал: вот эту верхнюю строку с фильтрами перенести бы. Или применить его на вновь созданных страницах.

Попробуй в этот кусок кода
CODE

  if (j > xBook.Sheets.Count) Then
     xBook.Sheets.Add , xBook.Sheets(xBook.Sheets.Count)
     xBook.Sheets(xBook.Sheets.Count).Name = CityName
   end if


втиснуть ещё пару строк, копирующих первую строку из начального листа

CODE

  if (j > xBook.Sheets.Count) Then
     xBook.Sheets.Add , xBook.Sheets(xBook.Sheets.Count)
     xBook.Sheets(xBook.Sheets.Count).Name = CityName
     xBook.Sheets(1).Rows(1).copy
     xBook.Sheets(xBook.Sheets.Count).Paste xBook.Sheets(xBook.Sheets.Count).Rows(1)
   end if


И, соответственно начало поиска пустой строки в листе города надо сместить с
CODE

' Ищем первую пустую строку в найденном листе - будем вставлять туда

  N = 1


на единичку вниз

CODE

' Ищем первую пустую строку в найденном листе - будем вставлять туда

  N = 2


Не знаю, поможет ли? Никогда не имел дела с фильтрами.
Если не поможет - обезличь как-нибудь файлик и пульни мне на мыло. Мыло в привате.
W colonel
8 ноября 2016, 10:34
Может очень глупый вопрос: Как в ячейку скопировать имя текущего листа?
ЧинаSки
8 ноября 2016, 11:28

W colonel :  Может очень глупый вопрос: Как в ячейку скопировать имя текущего листа? 

=ПСТР(ЯЧЕЙКА("filename";A1);ПОИСК("]";ЯЧЕЙКА("filename";A1))+1;31)
W colonel
8 ноября 2016, 13:07

ЧинаSки написал: =ПСТР(ЯЧЕЙКА("filename";A1);ПОИСК("]";ЯЧЕЙКА("filename";A1))+1;31)

Спасибо большое, работает. Но черт меня подери, если я знаю как.
Думал, все как-то проще, функция-то, на мой взгляд довольно востребованная.
ЧинаSки
8 ноября 2016, 13:20

W colonel : Но черт меня подери, если я знаю как.

"Ячейка" дает расположение ячейки, включая полный путь к файлу, имя файла и имя листа. Формат вывода известен - имя листа выводится без пробела после имени файла в квадратных скобках. То есть, задача, решаемая формулой, - вывести весь текст после закрывающей квадратной скобки.
alibek
8 ноября 2016, 14:06
Если можно использовать макросы, то можно еще и так:
CODE

Public Function SheetName(Optional ByVal adr As Range) As String
 Application.Volatile True
 If adr Is Nothing Then Set adr = Application.Caller
 SheetName = adr.Worksheet.Name
End Function

И в ячейке указать формулу: =SheetName([cell])
me45
9 ноября 2016, 12:27

Носки Поэта написал:
Не нужно. Всё же интересней сделать обработку их наличия.

Получается?
Носки Поэта
9 ноября 2016, 14:27

me45 написал: Получается? 

Попробуй:
CODE
Option Explicit
Dim oFSO ' объект для работы с файловой системой
Dim Excel  ' объект для работы с Excel

'Процедура читает файл с именем fPath ищет заголовок "Цена"
' переписывает все строки, в которых это поле не пустое в новый файл
' который потом сортирует по цене и сохраняет в SortDir,
' добавив к исходному имени "-sorted"
'
Sub MakeSort(fPath, SortDir)
Dim iBook, sBook, iSheet, sSheet, i, j, MaxColumn, iEmpties, iPrice
Dim oDir, oFile, oRange, sRange

Const MaxEmpties = 5 'Число пустых ячеек подряд, говорящее об окончании данных

Set iBook = Excel.Workbooks.open(fPath)          
set sBook = Excel.Workbooks.Add
Set iSheet = iBook.Sheets(1)
Set sSheet = sBook.Sheets(1)

' Предположим, что нам не известен номер столбца с ценой. Будем искать...
' Заодно определим максимальный номер непустого столбца. Он может быть и правее цены
iEmpties = 0
iPrice = 0
MaxColumn = 0
i = 1
While iEmpties < MaxEmpties
   If IsEmpty(iSheet.Cells(1,i).Value) Then
     iEmpties = iEmpties + 1
   Else
     iEmpties = 0
     MaxColumn = i
     If uCase(Trim(cStr(iSheet.Cells(1,i).Value))) = "ЦЕНА" Then
       iPrice = i
     End If
   End If
   i = i + 1
Wend

if iPrice > 0 Then
  i = 1
  j = 0
  iEmpties = 0
  While iEmpties < MaxEmpties
    If IsEmpty(iSheet.Cells(i,iPrice).Value) Then
      iEmpties = iEmpties + 1
    Else
      iEmpties = 0
      j = j + 1
      iSheet.Rows(i).copy
      sSheet.Paste sSheet.Rows(j)
    End If
    i = i + 1
  Wend
End If
iBook.Close ' закрываем исходный файл
iSheet = null
iBook = null

' Попробуем отсортровать по цене магическими заклинаниями

Set oRange = sSheet.Range(sSheet.Cells(2,1), sSheet.Cells(j,MaxColumn))
Set sRange = Excel.Range(sSheet.Cells(1,iPrice), sSheet.Cells(1,iPrice))
oRange.Sort sRange,,,,,,,2,,,1,1

' Сохраняем полученный файл после сортировки в папку SortDir, добавив к имени -sorted
sBook.SaveAs oFSO.BuildPath(SortDir, oFSO.GetBaseName(fPath) & "-sorted." & oFSO.GetExtensionName(fPath))

Excel.visible = False 'Если отладка закончена и ниже уже стоит False, можно убрать эту строку

sBook.Close
sBook = null
sSheet = null
end sub

' Основная процедура. Просматривает файлы в рабочей папке,
' и если находит файлы с расширением xlsx - передает их
' по очереди на обработку в процедуру MakeSort,
' затем перебрасывает отработанный исходный файл в архив

sub Wrk(WrkDir, SortDir, ArhDir)
Dim oDir, oFile 'объекты для работы с папками и файлами

If NOT oFSO.FolderExists( SortDir) Then oFSO.CreateFolder(SortDir)
If NOT oFSO.FolderExists( ArhDir) Then oFSO.CreateFolder(ArhDir)


Set oDir = oFSO.GetFolder(WrkDir)
for each oFile in oDir.Files
  If oFSO.GetExtensionName(oFile.Path) = "xlsx" Then
    Call MakeSort(oFile.Path, SortDir)
    oFile.Move(ArhDir)
  End If
next
end sub

' Это собственно программа

 Set oFSO = CreateObject("Scripting.FileSystemObject")
 Set Excel = CreateObject("Excel.Application")
 
 Excel.visible = True 'Для отладки. Потом лучше поставить False

'Передаем основной процедуре рабочую папку, папку сортировок и папку для архивирования исходных файлов
 wrk "F:\ME45\", "F:\ME45\SORT\", "F:\ME45\ARHIVE\"


Описание, извини, только если потребуется. Но вроде все должно быть понятно из предыдущей задачи, откуда скопирована львиная доля кода.


me45 написал: представь поиск на сайте, но в формате экселя, где вместо онлайн каталога товаров - набор прайсов в xls 

А вот это похоже тоже сегодня пересеклось с моими задачами. Если будет что-то вытанцовываться - выложу .
me45
9 ноября 2016, 15:39

Носки Поэта написал:
Попробуй:
[CODE]Option Explicit
Dim oFSO ' объект для работы с файловой системой
Dim Excel  ' объект для работы с Excel

'Процедура читает файл с именем fPath ищет заголовок "Цена"
' переписывает все строки, в которых это поле не пустое в новый файл


Описание, извини, только если потребуется. Но вроде все должно быть понятно из предыдущей задачи, откуда скопирована львиная доля кода.
.

Я правильно понимаю, что должен переименовать прайс-лист в fPath.xls и поместить его в одну папку с vbs-файлом, после чего запустить vbs?
Носки Поэта
9 ноября 2016, 15:50

me45 написал: Я правильно понимаю, что должен переименовать прайс-лист в fPath.xls и поместить его в одну папку с vbs-файлом, после чего запустить vbs? 

Нет. Так же, как и в предыдущей задаче в последней строке кода стоит вызов процедуры wrk, где первым параметром указывается рабочая папка, куда ты кладёшь прайсы с произвольными именами( но расширения обязательно xlsx), вторым параметром указывается папка, куда класть новые файлы с уже отсортированными данными, третьим параметром указывается папка архива, куда перенести после обработки исходный файл на хранение. Соответственно ты сам можешь задать свои имена папок, может даже разбросанные по разным дискам.

CODE
wrk "F:\ME45\", "F:\ME45\SORT\", "F:\ME45\ARHIVE\"


Собственно программа начинается с комментария
' Это собственно программа,
А выше неё вспомогательные подпрограммы Wrk и MakeSort, вызываемые из более нижних строк.

P.S. Если у тебя будут файлы с расширением .xls, то поправь в строчке
CODE
If oFSO.GetExtensionName(oFile.Path) = "xlsx" Then


xlsx на xls

А лучше напиши
CODE
If Left(oFSO.GetExtensionName(oFile.Path),3) = "xls" Then

Тогда будут обрабатываться и те и другие.
me45
9 ноября 2016, 16:10
/
me45
9 ноября 2016, 16:10

Носки Поэта написал:
Нет. Так же, как и в предыдущей задаче в последней строке кода стоит вызов процедуры wrk, где первым параметром указывается рабочая папка, куда ты кладёшь прайсы с произвольными именами( но расширения обязательно xlsx), вторым параметром указывается папка, куда класть новые файлы с уже отсортированными данными, третьим параметром указывается папка архива, куда перенести после обработки исходный файл на хранение. Соответственно ты сам можешь задать свои имена папок, может даже разбросанные по разным дискам.

CODE
wrk "F:\ME45\", "F:\ME45\SORT\", "F:\ME45\ARHIVE\"


Собственно программа начинается с комментария
' Это собственно программа,
А выше неё вспомогательные подпрограммы Wrk и MakeSort, вызываемые из более нижних строк.

P.S. Если у тебя будут файлы с расширением .xls, то поправь в строчке
CODE
If oFSO.GetExtensionName(oFile.Path) = "xlsx" Then


xlsx на xls

Выдает ошибку:
Строка 62
Символ 1
Ошибка: неизвестная
Код: 800A03EC
Носки Поэта
9 ноября 2016, 16:23

me45 написал: Строка 62 Символ 1 Ошибка: неизвестная Код: 800A03EC 

Хм. У меня 62 строка - это как раз первая строка магических заклинаний для вызова внутреннего демона excel'я.
CODE
Set oRange = sSheet.Range(sSheet.Cells(2,1), sSheet.Cells(j,MaxColumn))

Если у тебя это тоже она, то давай разбираться с тем, какая версия офиса у тебя стоит и в какой версии сделан сам исходный файл. Я отлаживал на 2010. Возможно эту часть тоже придётся переписывать на работу в самом скрипте, не отдавая окончательную сортировку офису.
Дальше >>
Эта версия форума - с пониженной функциональностью. Для просмотра полной версии со всеми функциями, форматированием, картинками и т. п. нажмите сюда.
Invision Power Board © 2001-2017 Invision Power Services, Inc.
модификация - Яро & Серёга
Хостинг от «Зенон»Сервера компании «ETegro»