Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Записи участника (krosav4ig) - Мир MS Excel

Старая форма входа
Мир MS Excel » Записи участника » krosav4ig [2343]
Результаты поиска
krosav4ig Дата: Понедельник, 26.01.2015, 00:12 | Сообщение № 1841 | Тема: Как в Excel (VBA) выделить 10 строк?
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[vba]
Код
Sub beereator()
        Dim i&, n&, WBtemp As Workbook, WSH As Worksheet
         Set WSH = ActiveSheet: n = 10
         With Application: .ScreenUpdating = 0: .EnableEvents = 0: .DisplayAlerts = 0
         For i = WSH.Cells.SpecialCells(xlCellTypeLastCell).Row \ n To 0 Step -1
             Set WBtemp = Workbooks.Add
             WSH.Rows(i * n + 1).Resize(10).Cut WBtemp.Sheets(1).[A1]
             WBtemp.SaveAs Filename:="C:\Users\Yura\Desktop\b" & i + 1, FileFormat:=6
             WBtemp.Close
         Next
         .ScreenUpdating = 1: .EnableEvents = 1: .DisplayAlerts = 1: End With
         Set WBtemp = Nothing: Set WSH = Nothing
End Sub
[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 26.01.2015, 12:59
 
Ответить
Сообщение[vba]
Код
Sub beereator()
        Dim i&, n&, WBtemp As Workbook, WSH As Worksheet
         Set WSH = ActiveSheet: n = 10
         With Application: .ScreenUpdating = 0: .EnableEvents = 0: .DisplayAlerts = 0
         For i = WSH.Cells.SpecialCells(xlCellTypeLastCell).Row \ n To 0 Step -1
             Set WBtemp = Workbooks.Add
             WSH.Rows(i * n + 1).Resize(10).Cut WBtemp.Sheets(1).[A1]
             WBtemp.SaveAs Filename:="C:\Users\Yura\Desktop\b" & i + 1, FileFormat:=6
             WBtemp.Close
         Next
         .ScreenUpdating = 1: .EnableEvents = 1: .DisplayAlerts = 1: End With
         Set WBtemp = Nothing: Set WSH = Nothing
End Sub
[/vba]
Автор - krosav4ig
Дата добавления - 26.01.2015 в 00:12
krosav4ig Дата: Воскресенье, 25.01.2015, 20:24 | Сообщение № 1842 | Тема: вытащить ссылки на картинки
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
еще вариант, для конкретно для этого сайта, на других работать не будет
[vba]
Код
Function GetImageLink$(url$)
     Application.Volatile False
     Dim oHTML: Set oHTML = CreateObject("MSXML2.XMLHTTP")
     oHTML.Open "GET", url, False: oHTML.send
     If oHTML.Status <> 200 Then Set oHTML = Nothing: Exit Function Else
     Dim oDoc: Set oDoc = CreateObject("htmlfile")
     oDoc.body.innerHTML = Split(oHTML.responseText, "item-image")(1)
     On Error Resume Next
     GetImageLink = oDoc.getElementsByTagName("img")(0).href
     Set oDoc = Nothing: Set oHTML = Nothing
End Function
[/vba]
К сообщению приложен файл: 8007979.xlsm (18.0 Kb)

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениееще вариант, для конкретно для этого сайта, на других работать не будет
[vba]
Код
Function GetImageLink$(url$)
     Application.Volatile False
     Dim oHTML: Set oHTML = CreateObject("MSXML2.XMLHTTP")
     oHTML.Open "GET", url, False: oHTML.send
     If oHTML.Status <> 200 Then Set oHTML = Nothing: Exit Function Else
     Dim oDoc: Set oDoc = CreateObject("htmlfile")
     oDoc.body.innerHTML = Split(oHTML.responseText, "item-image")(1)
     On Error Resume Next
     GetImageLink = oDoc.getElementsByTagName("img")(0).href
     Set oDoc = Nothing: Set oHTML = Nothing
End Function
[/vba]
Автор - krosav4ig
Дата добавления - 25.01.2015 в 20:24
krosav4ig Дата: Воскресенье, 25.01.2015, 20:16 | Сообщение № 1843 | Тема: Шпионские игры - шифрование текста.
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
все-таки не удержался :)
[vba]
Код
Private Sub AlphaBET()
     ArrA = Evaluate("transpose(mid(""tá<U¨Jnx#ÿ.Ód9åêwÒë{'+2g:÷%M6Y?ÇzÊLæi!þùZ§~Qk`" & _
                     "ÆoÖÐNäÚÂ^7OpRXS ØðDÄàCÑÃHu@ÏãjÔü>ì14G0Íör;Õýï$|eqBcô,lÌòõÁm&øˆ" & _
                     "ÎFî]Èß\ÞA[véñ8/3Ù_èÝúVPûç5h=íbT¸(-""""y)óâ}*ÅÉÛË×I¹ÜfWÀKasE""," & _
                     "row(1:164),1))")
End Sub
[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениевсе-таки не удержался :)
[vba]
Код
Private Sub AlphaBET()
     ArrA = Evaluate("transpose(mid(""tá<U¨Jnx#ÿ.Ód9åêwÒë{'+2g:÷%M6Y?ÇzÊLæi!þùZ§~Qk`" & _
                     "ÆoÖÐNäÚÂ^7OpRXS ØðDÄàCÑÃHu@ÏãjÔü>ì14G0Íör;Õýï$|eqBcô,lÌòõÁm&øˆ" & _
                     "ÎFî]Èß\ÞA[véñ8/3Ù_èÝúVPûç5h=íbT¸(-""""y)óâ}*ÅÉÛË×I¹ÜfWÀKasE""," & _
                     "row(1:164),1))")
End Sub
[/vba]
Автор - krosav4ig
Дата добавления - 25.01.2015 в 20:16
krosav4ig Дата: Суббота, 24.01.2015, 19:10 | Сообщение № 1844 | Тема: Скрыть окно помощи на панеле меню
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[vba]
Код
Application.CommandBars.DisableAskAQuestionDropdown = True
[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Суббота, 24.01.2015, 19:12
 
Ответить
Сообщение[vba]
Код
Application.CommandBars.DisableAskAQuestionDropdown = True
[/vba]
Автор - krosav4ig
Дата добавления - 24.01.2015 в 19:10
krosav4ig Дата: Суббота, 24.01.2015, 00:23 | Сообщение № 1845 | Тема: Шпионские игры - шифрование текста.
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
года 3 назад тоже пытался экспериментировать с шифрованием, получился вот такой банальненький алгоритм.
К сообщению приложен файл: ggg.xls (33.0 Kb)

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениегода 3 назад тоже пытался экспериментировать с шифрованием, получился вот такой банальненький алгоритм.
Автор - krosav4ig
Дата добавления - 24.01.2015 в 00:23
krosav4ig Дата: Четверг, 22.01.2015, 18:59 | Сообщение № 1846 | Тема: Условие для множества чисел
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[vba]
Код
If d.exists([a1].Value) Then Range("E3").Resize(d.Count) = Application.Transpose(d.keys)
[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение[vba]
Код
If d.exists([a1].Value) Then Range("E3").Resize(d.Count) = Application.Transpose(d.keys)
[/vba]
Автор - krosav4ig
Дата добавления - 22.01.2015 в 18:59
krosav4ig Дата: Четверг, 22.01.2015, 18:47 | Сообщение № 1847 | Тема: Скрыть окно помощи на панеле меню
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
My WebPage

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеMy WebPage
Автор - krosav4ig
Дата добавления - 22.01.2015 в 18:47
krosav4ig Дата: Четверг, 22.01.2015, 02:02 | Сообщение № 1848 | Тема: Подсчет без использования дополнительных таблиц
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
еще вариант, если будет больше дней/смен
1
Код
=СЧЁТЕСЛИ($C$4:ИНДЕКС($C$4:$Q$4;ПОИСКПОЗ(9^9;C5:Q5));ИНДЕКС($C$4:$Q$4;ПОИСКПОЗ(9^9;C5:Q5)))

2 у меня такая же, как у vikttur
Код
=СУММ(W5:Y5)

3-5
Код
=СЧЁТ(1/(ПРОМЕЖУТОЧНЫЕ.ИТОГИ(2;СМЕЩ(C5:Q5;;((""&$C$3:$Q$3)-1)*МАКС($C$4:$Q$4);;МАКС($C$4:$Q$4)))=1))

для 2х или 3х смен =1 заменить на =2 или =3

Upd.
3я формула массивная

еще вариант 1й формулы, тоже массивная
Код
=ОКРУГЛ(СЧЁТ(1/((СТОЛБЕЦ(C5:Q5)>=ТРАНСП(СТОЛБЕЦ(C5:Q5)-МАКС($C$4:$Q$4)))*C5:Q5*ТРАНСП(C5:Q5)))/СЧЁТ(C5:Q5);)

тока шо написал и сам не знаю как она работает :D

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 22.01.2015, 02:15
 
Ответить
Сообщениееще вариант, если будет больше дней/смен
1
Код
=СЧЁТЕСЛИ($C$4:ИНДЕКС($C$4:$Q$4;ПОИСКПОЗ(9^9;C5:Q5));ИНДЕКС($C$4:$Q$4;ПОИСКПОЗ(9^9;C5:Q5)))

2 у меня такая же, как у vikttur
Код
=СУММ(W5:Y5)

3-5
Код
=СЧЁТ(1/(ПРОМЕЖУТОЧНЫЕ.ИТОГИ(2;СМЕЩ(C5:Q5;;((""&$C$3:$Q$3)-1)*МАКС($C$4:$Q$4);;МАКС($C$4:$Q$4)))=1))

для 2х или 3х смен =1 заменить на =2 или =3

Upd.
3я формула массивная

еще вариант 1й формулы, тоже массивная
Код
=ОКРУГЛ(СЧЁТ(1/((СТОЛБЕЦ(C5:Q5)>=ТРАНСП(СТОЛБЕЦ(C5:Q5)-МАКС($C$4:$Q$4)))*C5:Q5*ТРАНСП(C5:Q5)))/СЧЁТ(C5:Q5);)

тока шо написал и сам не знаю как она работает :D
Автор - krosav4ig
Дата добавления - 22.01.2015 в 02:02
krosav4ig Дата: Четверг, 22.01.2015, 00:49 | Сообщение № 1849 | Тема: Ежемесячное действие
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
rand81, вот так

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеrand81, вот так
Автор - krosav4ig
Дата добавления - 22.01.2015 в 00:49
krosav4ig Дата: Четверг, 22.01.2015, 00:43 | Сообщение № 1850 | Тема: Максимальное значение каждой строки в диапазоне.
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
oleg_lar4enko, правила не читали, или не внимательно dont , оформляйте код тегами
еще вариант
[vba]
Код
Sub max()
     With [C1:E50]
         .Offset(, .Columns.Count).Resize(, 1).Formula = "=MAX(" & .Address & " " & .EntireRow(1).Address(0, 0) & ")"
     End With
End Sub
[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 22.01.2015, 00:44
 
Ответить
Сообщениеoleg_lar4enko, правила не читали, или не внимательно dont , оформляйте код тегами
еще вариант
[vba]
Код
Sub max()
     With [C1:E50]
         .Offset(, .Columns.Count).Resize(, 1).Formula = "=MAX(" & .Address & " " & .EntireRow(1).Address(0, 0) & ")"
     End With
End Sub
[/vba]
Автор - krosav4ig
Дата добавления - 22.01.2015 в 00:43
krosav4ig Дата: Среда, 21.01.2015, 11:51 | Сообщение № 1851 | Тема: генератор штрих кода
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
и вот еще
[p.s.]b1 - это архив, открывается через B1 archive manager, можно распаковать тут

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеи вот еще
[p.s.]b1 - это архив, открывается через B1 archive manager, можно распаковать тут
Автор - krosav4ig
Дата добавления - 21.01.2015 в 11:51
krosav4ig Дата: Вторник, 20.01.2015, 13:43 | Сообщение № 1852 | Тема: Непростое сравнение двух столбцов
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
как-то так, Условное форматирование
К сообщению приложен файл: 3527399.xls (29.5 Kb)

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениекак-то так, Условное форматирование
Автор - krosav4ig
Дата добавления - 20.01.2015 в 13:43
krosav4ig Дата: Вторник, 20.01.2015, 13:21 | Сообщение № 1853 | Тема: Непростое сравнение двух столбцов
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
ТЫК

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеТЫК
Автор - krosav4ig
Дата добавления - 20.01.2015 в 13:21
krosav4ig Дата: Понедельник, 19.01.2015, 23:34 | Сообщение № 1854 | Тема: VBA - определение максимального значения в колонке
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
[vba]
Код
[max(A:A)]
[/vba] :o

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщение[vba]
Код
[max(A:A)]
[/vba] :o
Автор - krosav4ig
Дата добавления - 19.01.2015 в 23:34
krosav4ig Дата: Понедельник, 19.01.2015, 23:31 | Сообщение № 1855 | Тема: Файл увеличивается в размере.
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
можно еще [vba]
Код
cells(i,1)=empty
[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеможно еще [vba]
Код
cells(i,1)=empty
[/vba]
Автор - krosav4ig
Дата добавления - 19.01.2015 в 23:31
krosav4ig Дата: Понедельник, 19.01.2015, 19:39 | Сообщение № 1856 | Тема: Эксель не работае* нормально обмен между книгами.
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Alexsandr, берем англо-русский словарь и идем читать :)

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеAlexsandr, берем англо-русский словарь и идем читать :)
Автор - krosav4ig
Дата добавления - 19.01.2015 в 19:39
krosav4ig Дата: Понедельник, 19.01.2015, 19:24 | Сообщение № 1857 | Тема: Файл увеличивается в размере.
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
может быть стоит попроовать [vba]
Код
Cells(i,1).clearcontents
[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеможет быть стоит попроовать [vba]
Код
Cells(i,1).clearcontents
[/vba]
Автор - krosav4ig
Дата добавления - 19.01.2015 в 19:24
krosav4ig Дата: Понедельник, 19.01.2015, 12:55 | Сообщение № 1858 | Тема: Формула возвращает много знаков после запятой
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
light26,
формула
Код
=ЕСЛИОШИБКА(ЕСЛИ(И(BQ6:CB6);BW6-BQ6;"");"")

числовой формат
увели\чило\сь на 0,0;у\меньшило\сь на 0,0;без из\менений
и будет вам счастье
К сообщению приложен файл: 4612782.zip (56.9 Kb)

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 19.01.2015, 12:55
 
Ответить
Сообщениеlight26,
формула
Код
=ЕСЛИОШИБКА(ЕСЛИ(И(BQ6:CB6);BW6-BQ6;"");"")

числовой формат
увели\чило\сь на 0,0;у\меньшило\сь на 0,0;без из\менений
и будет вам счастье
Автор - krosav4ig
Дата добавления - 19.01.2015 в 12:55
krosav4ig Дата: Понедельник, 19.01.2015, 02:33 | Сообщение № 1859 | Тема: Вывод в ячейку номера цикла при условии
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
вариант 1
[vba]
Код
Sub Макрос1()
       Dim i&
       For i = 1000 To 50000 Step 1000
           [A1] = Trim([A1] & " " & i)
       Next i
End Sub
[/vba]
вариант 2
[vba]
Код
Sub Макрос1()
       Dim i&
       For i = 1 To 50000
           If i Mod 1000 = 0 Then [A1] = Trim([A1] & " " & i)
       Next i
End Sub
[/vba]
вариант 3 без цикла
[vba]
Код
Sub Макрос1()
      [A1] = Join(Evaluate("transpose(ROW(1:" & 50000 \ 1000 & "))*1000"), " ")
End Sub
[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Понедельник, 19.01.2015, 02:52
 
Ответить
Сообщениевариант 1
[vba]
Код
Sub Макрос1()
       Dim i&
       For i = 1000 To 50000 Step 1000
           [A1] = Trim([A1] & " " & i)
       Next i
End Sub
[/vba]
вариант 2
[vba]
Код
Sub Макрос1()
       Dim i&
       For i = 1 To 50000
           If i Mod 1000 = 0 Then [A1] = Trim([A1] & " " & i)
       Next i
End Sub
[/vba]
вариант 3 без цикла
[vba]
Код
Sub Макрос1()
      [A1] = Join(Evaluate("transpose(ROW(1:" & 50000 \ 1000 & "))*1000"), " ")
End Sub
[/vba]
Автор - krosav4ig
Дата добавления - 19.01.2015 в 02:33
krosav4ig Дата: Суббота, 17.01.2015, 03:55 | Сообщение № 1860 | Тема: Сравнение двух листов, подстановка данных (массив/словарь)
Группа: Друзья
Ранг: Старожил
Сообщений: 2348
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
может немного не в тему, но все-таки предложу вариант с Power Query, авось где-нить пригодится. Данные для запроса берутся из двух именованных диапазонов.
К сообщению приложен файл: 5573520.xlsm (45.0 Kb)

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеможет немного не в тему, но все-таки предложу вариант с Power Query, авось где-нить пригодится. Данные для запроса берутся из двух именованных диапазонов.
Автор - krosav4ig
Дата добавления - 17.01.2015 в 03:55
Мир MS Excel » Записи участника » krosav4ig [2343]
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!