Имеется несколько сот картинок (.jpg) с различными названиями. В конце каждого указаны их размеры (в пикселя), напр.
1. Во поле береза стояла - 539Х245 2. Пес Барбос - 400Х400 3. Кащей Бессмертный - 489Х732 4. Ну погоди - 310Х450 5. Крокодил Гена 75Х75 6. Поле чудес - 86Х95 7. Бременские музыканты - 1893Х869 8. Деревня Простоквашино - 1942Х1942
Нужно выделить и скопировать только те ячейки, где неквадратные картинки (они могут быть 2-x, 3-x или 4-x значные), то есть цифры, стоящие до и после знака Х. Желательно, чтобы была возможность умной сортировки, а именно сначала большие в высоту а потом меньшие в ширину. Как можно это выполнить?
А как сами пытались? Как задано? Как рекомендовано/запрещено? ps См. Правила - пп 2.2, 2.3. pps Размеры разогнать на 2 колонки и с ними работать: равны - квадратные, не равны - прямоугольные... ppps На братском форуме размеры фото в теме - http://www.excelworld.ru/forum/10-37603-1#247971
В макросах я не разбираюсь. Hо попадались решения похожих задач стандартным путем отлова данных. Формулы, умеющей отсечь только неидентичные цифры по правую и левую сторону от Х нет?
Маску по задаче даже не знаю как прописать, чтобы высветилось в поиске. Если бы было нечто похожее, то я написал бы в теме. Но таковой не нашлось, поэтому открыл новую.
Цитата
Bema написал: Можно и формулами, но где их писать?
Sub FindAndSort()
Dim x&, y&, a&, b%, cc As Byte, dt$, arr(), arr0(), aa As Range, bb As Range, arrF()
On Error Resume Next
Set aa = Application.InputBox("Выберите диапазон для сортировки.", , "A1:A5", , , , , 8)
On Error GoTo 0
If Not aa Is Nothing Then
arr0 = aa.Value
Else
arr0 = Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, 1)).Value
End If
ReDim arr(1 To UBound(arr0, 1), 1 To 3)
For a = 1 To UBound(arr0, 1)
x = IIf(InStr(arr0(a, 1), "X") > 0, InStr(arr0(a, 1), "X"), InStr(arr0(a, 1), "Х"))
arr(a, 2) = CLng(Right(arr0(a, 1), Len(arr0(a, 1)) - x))
arr(a, 3) = a
For b = x - 1 To 1 Step -1
cc = Asc(Mid(arr0(a, 1), b, 1))
Select Case cc
Case Is < 48, Is > 57: arr(a, 1) = CLng(Mid(arr0(a, 1), b + 1, x - b - 1)): Exit For
End Select
Next
Next
ArrSort arr(), 2: ArrSort arr(), 1
ReDim arrF(1 To UBound(arr0, 1), 1 To 1)
For a = 1 To UBound(arr, 1): arrF(a, 1) = arr0(arr(a, 3), 1): Next
On Error Resume Next
Set bb = Application.InputBox("Выберите ячейку для вставки отсортированного массива.", , , , , , , 8)
On Error GoTo 0
If Not bb Is Nothing Then
bb.Resize(UBound(arrF, 1), 1) = arrF
Else
[B1].Resize(UBound(arrF, 1), 1) = arrF
End If
End Sub
'--процедура сортировщика--
Sub ArrSort(mass(), ByVal n%)
Dim a&, b&, c&, i&, xx&, jj&, mm, x1&
Dim arr&(), arr0&(), sArr()
If UBound(mass, 1) < 2 Then Exit Sub
ReDim arr(1 To UBound(mass, 1))
ReDim arr0(1 To UBound(mass, 1)): xx = 1
For i = 1 To UBound(mass, 1): arr(i) = i: Next
b = UBound(mass, 1): c = b / 1.247331: i = 1
Do While c > 2
Do While i + c <= b
If mass(arr(i), n) > mass(arr(i + c), n) Then
x1 = arr(i): arr(i) = arr(i + c): arr(i + c) = x1
End If
i = i + 1
Loop
c = c / 1.247331: i = 1
Loop
jj = xx: arr0(xx) = arr(1)
For c = 2 To b
xx = xx + 1: x1 = xx
mm = mass(arr(c), n)
Do While mass(arr0(x1 - 1), n) > mm
arr0(x1) = arr0(x1 - 1): x1 = x1 - 1
If x1 = jj Then Exit Do
Loop
arr0(x1) = arr(c)
Next
ReDim sArr(1 To UBound(mass, 1), 1 To UBound(mass, 2))
For a = 1 To UBound(arr0)
For c = 1 To UBound(mass, 2)
sArr(a, c) = mass(arr0(a), c)
Next c
Next a: Erase arr: Erase arr0
mass = sArr: Erase sArr
End Sub
Z и Bema благодарю. То, что надо. Охо. И все-таки я нашел ошибки. Числa 170Х170 (2 раза), 142Х142 (2 раза), 286X286 (5 раза), 300X300, 320X320, 406X406, 418X418, 500X500 (4 раза), 422X422 (17 раз), 500X500 (2 раза), 600X600 (3 раза) и 640Х640 (3 раза) были распознаны, как ЛОЖЬ, тогда как это квадратные изображения. Возможно, там еще есть ошибки, просто не до конца еще проверил. Наверное формула чувствительна к сочитаниям цифр или как?
Excaz написал: Наверное формула чувствительна к сочитаниям цифр или как?
Скорее - "или как", но диагноз - только после вскрытия вашего примера... ps Как вариант - сравните написание размеров у крокодила и других. pps А как отработал макрос Anchoret - без проблем?
Z написал: Скорее - "или как", но диагноз - только после вскрытия вашего примера... ps Как вариант - сравните написание размеров у крокодила и других.pps А как отработал макрос Anchoret - без проблем?
Макрос не знаю куда вписывать. Проверка выявила 42 ошибок в 1431 файлах. Можете проверить указанные значения, почему формула спотыкается на них. Мне кажется, в формуле нужно заменить разделитель тире, стоящий перед размером картинки, на уникальный знак, скажем # (он нигде не встречается в списке). Эта формула (что ниже) точнее. Но у меня почему-то вместо слов квадрат или прямоугольник пишет неэстетичные ЛОЖЬ и #ИМЯ?
Макрос работает по следующему принципу: - предлагает выбрать диапазон для обработки - загоняет этот диапазон в массив - создает вспомогательный массив, куда помещает высоту/ширину/индекс - полученный массив сортируется по возрастанию сначала по ширине, потом по высоте предполагаемых картинок - в третий по счету массив по индексам загоняются данные из первоначального массива/диапазона - далее предлагается определить место выгрузки на лист и собственно выгрузка
Т.е. выгружаются первоначальные значения отсортированные по возрастанию по высоте картинок.
Вставка: Alt + F11/правый клик на книге слева вверху/вставить/модуль/в этот модуль вставляется макрос
П.С.: Можно выгружать массив из названий картинок, высоты, ширины, квадрат/прямоугольник. Но для этого требуется небольшая редакция.
у меня почему-то вместо слов квадрат или прямоугольник пишет неэстетичные ЛОЖЬ и #ИМЯ?
И как из картинки выковырять Ваши формулы с ошибками? Вы за помощью зашли или для раздачи загадок? Почему на форуме по Excel картинки рисуете? Правила форума. о файле-примере. Обязательно зайдите, ознакомьтесь. Иначе людям просто надоест заходить в Вашу тему. Помощь нужна Вам и Вы сами должны приложить максимум усилий для ее приближения.