» Excel VBA

Никто не подскажет как можно экселевский макрос запустить в Аксесе?
[more=Сам макрос]
Sub utf8()
'
' utf8 Makro
' Convert UTF-8 characters to Excel format
'
' key combination: Strg+w
'

' a acute big
Cells.Replace What:="Á", Replacement:="Á", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a acute small
Cells.Replace What:="á", Replacement:="á", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a brevis small
Cells.Replace What:="ă", Replacement:=ChrW(259), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a cedilla big
Cells.Replace What:="Ä„", Replacement:=ChrW(260), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a cedilla small
Cells.Replace What:="Ä…", Replacement:=ChrW(261), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a circumflex big
Cells.Replace What:="Â", Replacement:="Â", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a circumflex small
Cells.Replace What:="â", Replacement:="â", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a grave small
Cells.Replace What:="à", Replacement:="à", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a macron big
Cells.Replace What:="Ä€", Replacement:=ChrW(256), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a macron small
Cells.Replace What:="ā", Replacement:=ChrW(257), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a ring big
Cells.Replace What:="Ã…", Replacement:="Å", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a ring small
Cells.Replace What:="Ã¥", Replacement:="å", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a tilde small
Cells.Replace What:="ã", Replacement:="ã", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a umlaut big
Cells.Replace What:="Ä", Replacement:="Ä", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' a umlaut small
Cells.Replace What:="ä", Replacement:="ä", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' ae ligature small
Cells.Replace What:="æ", Replacement:="æ", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' ae ligature big
Cells.Replace What:="Æ", Replacement:="Æ", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' c acute big
Cells.Replace What:="Ć", Replacement:=ChrW(262), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' c acute small
Cells.Replace What:="ć", Replacement:=ChrW(263), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' c caron big
Cells.Replace What:="Č", Replacement:=ChrW(268), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' c caron small
Cells.Replace What:="č", Replacement:=ChrW(269), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' c cedilla big
Cells.Replace What:="Ç", Replacement:="Ç", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' c cedilla small
Cells.Replace What:="ç", Replacement:="ç", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' d dash big
Cells.Replace What:="Đ", Replacement:=ChrW(272), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' d dash small
Cells.Replace What:="Ä‘", Replacement:=ChrW(273), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' dh small small
Cells.Replace What:="ð", Replacement:="ð", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e acute big
Cells.Replace What:="É", Replacement:="É", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e acute small
Cells.Replace What:="é", Replacement:="é", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e caron small
Cells.Replace What:="Ä›", Replacement:=ChrW(283), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e cedilla small
Cells.Replace What:="Ä™", Replacement:=ChrW(281), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e circumflex small
Cells.Replace What:="ê", Replacement:="ê", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e grave big
Cells.Replace What:="È", Replacement:="È", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e grave small
Cells.Replace What:="è", Replacement:="è", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e macron big
Cells.Replace What:="Ä’", Replacement:=ChrW(274), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e macron small
Cells.Replace What:="Ä“", Replacement:=ChrW(275), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e point small
Cells.Replace What:="Ä—", Replacement:=ChrW(279), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e turned big
Cells.Replace What:="Ə", Replacement:=ChrW(399), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e turned small
Cells.Replace What:="É™", Replacement:=ChrW(601), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
Cells.Replace What:="ǝ", Replacement:=ChrW(601), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' e umlaut small
Cells.Replace What:="ë", Replacement:="ë", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' g brevis small
Cells.Replace What:="ÄŸ", Replacement:=ChrW(287), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' g point big
Cells.Replace What:="Ä ", Replacement:=ChrW(288), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' g point small
Cells.Replace What:="Ä¡", Replacement:=ChrW(289), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' h macron big
Cells.Replace What:="Ħ", Replacement:=ChrW(294), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' h macron small
Cells.Replace What:="ħ", Replacement:=ChrW(295), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' i acute big
Cells.Replace What:="Í", Replacement:="Í", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' i acute small
Cells.Replace What:="Ã-", Replacement:="í", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' i brevis small
Cells.Replace What:="Ä-", Replacement:=ChrW(301), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' i circumflex big
Cells.Replace What:="ÃŽ", Replacement:="Î", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' i circumflex small
Cells.Replace What:="î", Replacement:="î", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' i grave small
Cells.Replace What:="ì", Replacement:="ì", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' i macron big
Cells.Replace What:="Ī", Replacement:=ChrW(298), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' i macron small
Cells.Replace What:="Ä«", Replacement:=ChrW(299), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' i pointed big
Cells.Replace What:="Ä°", Replacement:=ChrW(304), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' i pointless small
Cells.Replace What:="ı", Replacement:=ChrW(305), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' i umlaut small
Cells.Replace What:="ï", Replacement:="ï", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' k cedilla big
Cells.Replace What:="Ķ", Replacement:=ChrW(310), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' k cedilla small
Cells.Replace What:="Ä·", Replacement:=ChrW(311), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' l cedilla small
Cells.Replace What:="ļ", Replacement:=ChrW(316), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' l slash big
Cells.Replace What:="Ł", Replacement:=ChrW(321), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' l slash small
Cells.Replace What:="Å‚", Replacement:=ChrW(322), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' n acute small
Cells.Replace What:="Å„", Replacement:=ChrW(324), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' n caron small
Cells.Replace What:="ň", Replacement:=ChrW(328), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' n cedilla small
Cells.Replace What:="ņ", Replacement:=ChrW(326), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' n tilde big
Cells.Replace What:="Ñ", Replacement:="Ñ", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' n tilde small
Cells.Replace What:="ñ", Replacement:="ñ", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o acute big
Cells.Replace What:="Ó", Replacement:="Ó", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o acute small
Cells.Replace What:="ó", Replacement:="ó", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o brevis big
Cells.Replace What:="ÅŽ", Replacement:=ChrW(334), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o brevis small
Cells.Replace What:="ŏ", Replacement:=ChrW(335), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o circumflex small
Cells.Replace What:="ô", Replacement:="ô", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o double acute big
Cells.Replace What:="Ö", Replacement:=ChrW(336), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o double acute small
Cells.Replace What:="Å‘", Replacement:=ChrW(337), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o grave small
Cells.Replace What:="ò", Replacement:="ò", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o macron big
Cells.Replace What:="Ō", Replacement:=ChrW(332), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o macron small
Cells.Replace What:="ō", Replacement:=ChrW(333), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o slash big
Cells.Replace What:="Ø", Replacement:="Ø", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o slash small
Cells.Replace What:="ø", Replacement:="ø", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o tilde small
Cells.Replace What:="õ", Replacement:="õ", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' o umlaut small
Cells.Replace What:="ö", Replacement:="ö", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' r caron big
Cells.Replace What:="Ř", Replacement:=ChrW(344), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' r caron small
Cells.Replace What:="Å™", Replacement:=ChrW(345), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' r cedilla small
Cells.Replace What:="Å—", Replacement:=ChrW(343), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' s acute big
Cells.Replace What:="Åš", Replacement:=ChrW(346), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' s acute small
Cells.Replace What:="Å›", Replacement:=ChrW(347), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' s caron big
Cells.Replace What:="Å ", Replacement:=ChrW(352), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' s caron small
Cells.Replace What:="Å¡", Replacement:=ChrW(353), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' s cedilla big
Cells.Replace What:="Åž", Replacement:=ChrW(350), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' s cedilla small
Cells.Replace What:="ÅŸ", Replacement:=ChrW(351), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' sz ligature small
Cells.Replace What:="ß", Replacement:="ß", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' t cedilla big
Cells.Replace What:="Å¢", Replacement:=ChrW(354), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' t cedilla small
Cells.Replace What:="Å£", Replacement:=ChrW(355), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' thorn big
Cells.Replace What:="Þ", Replacement:="Þ", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u acute big
Cells.Replace What:="Ú", Replacement:="Ú", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u acute small
Cells.Replace What:="ú", Replacement:="ú", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u brevis big
Cells.Replace What:="Ŭ", Replacement:=ChrW(364), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u brevis small
Cells.Replace What:="Å-", Replacement:=ChrW(365), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u cedilla small
Cells.Replace What:="ų", Replacement:=ChrW(371), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u circumflex small
Cells.Replace What:="û", Replacement:="û", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u double acute small
Cells.Replace What:="ű", Replacement:=ChrW(369), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u grave small
Cells.Replace What:="ù", Replacement:="ù", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u macron big
Cells.Replace What:="Ū", Replacement:=ChrW(362), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u macron small
Cells.Replace What:="Å«", Replacement:=ChrW(363), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u ring small
Cells.Replace What:="ů", Replacement:=ChrW(367), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u umlaut big
Cells.Replace What:="Ãœ", Replacement:="Ü", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' u umlaut small
Cells.Replace What:="ü", Replacement:="ü", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' y acute small
Cells.Replace What:="ý", Replacement:="ý", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' z acute small
Cells.Replace What:="ź", Replacement:=ChrW(378), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' z caron big
Cells.Replace What:="Ž", Replacement:=ChrW(381), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' z caron small
Cells.Replace What:="ž", Replacement:=ChrW(382), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' z point big
Cells.Replace What:="Å»", Replacement:=ChrW(379), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' z point small
Cells.Replace What:="ż", Replacement:=ChrW(380), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' cedilla
Cells.Replace What:="̨", Replacement:=ChrW(808), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' diaresis
Cells.Replace What:="̈", Replacement:=ChrW(776), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' halfcircle, right open
Cells.Replace What:="´", Replacement:=ChrW(703), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' macron
Cells.Replace What:="Ì„", Replacement:=ChrW(772), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' macron below
Cells.Replace What:="̱", Replacement:=ChrW(817), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True
' apostroph
Cells.Replace What:="ʼ", Replacement:=ChrW(700), LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True




End Sub
[/more]

zporuchik
Похоже, ты пытаешься использовать экселевскую объектную модель (Cells) в аксессе. Не получится. Надо макрос переписывать. Функция Replace имеет такой же синтаксис, а вот объект должен быть другим. Зависит от того, что ты хочешь делать. Но это тема уже для другого форума.
Если же ты хочешь переконвертировать экселевский файл из аксесса, это в принципе можно.

Цитата:

выдели в исходной странице столбец с числами, выбери формат ячейки, поставь числовой и количество знаков после
запятой побольше (ну хотя бы два знака после запятой). наверняка увидишь дробные части... )

Я же с математической точки зрения, и пример ведь привёл. Выставите вы
количество знаков побольше - но ведь от суммирования целых чисел не
могут получаться дробные, и при суммировании 2 + 2 не может получаться
число 3.5!


Цитата:

Это свойство End. Для всей строчки используй Selection.EntireRow.

Я опять не так понял что-то:

Код: Range(Selection.EntireRow(xlToLeft), Selection.EntireRow(xlToRight)).Copy

Denis_Kokyev
SERGE_BLIZNUK имел ввиду, что если ты видишь целое число, это не значит, что у тебя в ячейке целое число. Прежде чем грешить на макрос, просуммируй прямо в листе через функцию СУММ.


Цитата:

Это свойство End. Для всей строчки используй Selection.EntireRow.

Попробуй в листе понажимать End, затем стрелку вправо, или End влево. Именно это и делает End в макросе, то есть возвращает ячейку, на которую ты попал, нажимая на End-влево (xlToLeft) или End-вправо (xlToRight). Есть также xlUp и xpDown. Это все экселевские константы направления, которые в свойству Entire Row не имеют ни какого отношения.
Тебе нужно
Код: Selection.EntireRow.Copy

Цитата:

Прежде чем грешить на макрос, просуммируй прямо в листе через функцию СУММ.

Забыл написать. Как раз-таки СУММ выдает нормальное значение.


Цитата:

Вообще, если встречаешь какую-либп функцию, зайди в хелп и почитай о ней. Узнаешь много интересного.

Это первое, что я сделал. Но не нашёл. По всякому пытался - но в help,
по поиску этой функции, мне возвращает - "поиск не дал результатов".


Цитата:

Range("F1").Value=WorksheetFunction.Sum(Range("E:E"))

Спасибо огромное - этот код помог - считает нормально!

Добавлено:
Денчик Тупой, причём очень! Я понял, откуда вылезают дроби, и что Вы
имели ввиду, а я мучался! Спасибо Вам!

Denis_Kokyev

Цитата:

"поиск не дал результатов"

Иногда помогает "Просмотр объектов" (F2). А также гугл.

Доброго времени суток.
Как перегонять выбранные ячейки в одномерный массив?
Вот собсна и весь вопрос.

DeadVillage
Посмотри, как это сделано здесь:
http://forum.ru-board.com/topic.cgi?forum=33&topic=3961&start=420#5
Основные моменты:

Код: Option Base 1
...
Dim aArray() As Variant 'динамический массив
...
ReDim aArray(Selection.Count) 'выделяем размер
i = 1
For Each c In Selection
aArray(i) = c.Value
i = i + 1
Next
...

Как сделать из двух строк одну в Exel? Надо,чтобы верхняя строка становилась слева от нижней...
Например:
111111111111
222222222222
333333333333
444444444444



111111111111 - эту строку надопоставить перед строкой 22222222222
111111111111222222222222 - вот что должно получиться
333333333333 - эту поставить перед строкой 44444444444
3333333333334444444444444 - вот что должно получиться здесь
и т.д.
И при этом не должно быть пробелов между между строками...
Помогите плз!!!
Это очень срочно!!!

agrippa
Обязательно нужен макрос?

Код: =IF(MOD(ROW(A1),2)<>0,A1&A2,"")

Спасибо вам большое, Yuk. Век вас не забуду. Вы мне очень помогли.

Здравствуйте и Доброго Вам времени суток!
Есть трабл ПОМОГИТЕ плз. нужно в VBA (Excel) написать записную книжку:
В ней должно содержаться 3 раздела: заметки, дни рождения, список запланированных дел. При запуске приложения должно выскакивать напоминание о делах которые нужно выполнить сегодня(согласно системной дате). В разделе "Дни рожения" должна вводится дата и за сколько дней до нее напомнить.
Пожалуйста помогите с написанием или укажите ссылки на примеры.
Плз Помогите, а то меня повесят!!! Заранее благодарен!

Столкнулся с необходимостью освоения VBA. До этого писал исключительно на Оbject Paskal и C++. Вопрос, может не совсем по теме: Нужно сохранить полностью статью "Первые шаги с vba excel", т.е. с функционированием иерархического оглавления. Помогите, пожалуйста, кто в курсе. Может у кого есть ссылки на дельные статьи и учебники, - буду очень признателен. Заранее спасибо.

rebroff
Вот ссылочка: _http://www.citforum.ru/programming/digest/excel_vba.shtml

Цитата:

agrippa
Обязательно нужен макрос?

Код:=IF(MOD(ROW(A1),2)<>0,A1&A2,"")

Извини,Yuk, это формула? А как мне её использовать? Она не хочет работать... Может есть другое решение? Пожалуйста, помоги мне снова...

Мне нужно чтобы прога делала эту операцию(из предыдущего вопроса) только со строками вида
111111111111
222222222222
333333333333
444444444444,

а пустые и те,в которых текст - пропускала и искала строки этого вида
111111111111
222222222222
333333333333
444444444444...

zQuatroz
Интересный подход а эксел такое писать, я предложил посмотреть в сторону Access, но можно поизвращатся и в Exel. Можно сделать так создать 3 скрытых листа и использовать их как базу данных. А при открытии на трех видимых листах с красивым оформлением и названиями (дни рож.. и тд.) (кстати их можно заблокировать от редактирования о приопределить нажатия на ентер и прочие клавиши.) выводить заметки и днирождения также можно толбар свой прикрутить. Кнопка Добавить заметку, добавить день рожденья. А если еще использовать ActivX компоненты Grid нормальный то вобще фантазий нет предела.
Пирмеров нет, но если что нужно более детально по реализации подскажу пиши.

Добавлено:
agrippa
Вот тебе примерно такая программка


Цитата:

Sub SeekStr()
Dim RangShet As Range
Dim I As Integer
Dim PreStr As String

Set RangShet = Application.Worksheets("Лист1").UsedRange //Выбираем используемую область на странице

I = 0
For I = 1 To RangShet.Rows.Count // делаем обход ее по строкам
Set rw = RangShet.Rows(I)
PreStr = rw.Cells(1, 1).Value //Исходим что данная строка у тебя в первой колонке
If PreStr <> "" Then // здесь условия на строку если то что нужно тогда все в порядке
rw.Delete //Значение стороки запомнили и удалили строку
Set rw = RangShet.Rows(I) //Строки сместились и теперь уже под таки же индексом но уж новая строка та что была ниже
PreStr = PreStr + rw.Cells(1, 1).Value
rw.Cells(1, 1).Value = PreStr // ну теперь конкатенируем строки
End If
Next
End Sub

agrippa
Забудь про формулу.
Вот тебе макрос:

Код: Sub MergeCells()
first = True
rownum = 1
For Each c In Selection
If IsNumeric(c) And Not IsEmpty(c) Then
If first Then
tmpstr = CStr(c)
first = False
Else
Cells(rownum, c.Column + 1) = Chr(39) & tmpstr & CStr(c)
first = True
rownum = rownum + 1
End If
End If
Next
End Sub

Спасибо большое. Еще вопрос: а можно сделать так,чтобы макрос создавал еще один лист сам,переносил туда еще не объединенные строки и рядом с ними(через столбец) поставил уже объединенные??? И чтобы после обрыва таблицы(когда первый ряд объединяемых строк заканчивался) и когда будет объединять строки другой таблицы,создал новый лист и сделал тоже,что и с первым? Извините меня,что гружу,но мне именно это надо... Заранее,большое спасибо!

agrippa

Цитата:

а можно сделать так,чтобы макрос создавал еще один лист сам,переносил туда еще не объединенные строки и рядом с ними(через столбец) поставил уже объединенные??? И чтобы после обрыва таблицы(когда первый ряд объединяемых строк заканчивался) и когда будет объединять строки другой таблицы,создал новый лист и сделал тоже,что и с первым?

Несколько раз перечитал, но так и не понял задачу. Еще раз, пожалуйста, с примерами (что на входе и что надо на выходе), названиями листов и конкретными адресами. Хотелось бы также знать, для чего это все надо.

Кстати, ты пробовал хоть один из предложенных макросов, или RedPromo или мой? Какой больше подходит?

Лист1 | Лист2 | Лист3
111111111111 | 111111111111 111111111111222222222222 | 555555555555 555...666
222222222222 | 222222222222 333333333333444444444444 | 666666666666 777...888
333333333333 | 333333333333 | 777777777777
444444444444 | 444444444444 | 888888888888
| |
| |
| |
555555555555 | |
666666666666 | |
777777777777 | |
888888888888 | |
| |

Мне это по учёбе надо...

Макрос RedPromo выдаёт ошибку... Твой макрос,уважаемый Yuk, почему-то у меня вообще ничего не делает...

agrippa

Цитата:

Твой макрос,уважаемый Yuk, почему-то у меня вообще ничего не делает...

Исходные ячейки выделял?


Цитата:

Макрос RedPromo выдаёт ошибку...

в коментах заменить // на '

Цитата:

PreStr = PreStr + rw.Cells(1, 1).Value

Здесь надо & вместо +

Ты писал. что возможны ячейки с текстом. Где они в примере?

Yuk

Цитата:

Здесь надо & вместо +

Не обязательно работает и так.

Мой пример полностью проверен. Единственное что так это коменты их я дописывал после уже я просто подумал что это очевидно тх убрать.
Да и еще что хорошего макросе Yuk так это проверка на тип возвращаемого значения если в моем примере попадется чило скорее всего будет Exseption.

Добавлено:
agrippa
Выложи свой лист с данными котрые нуно обработать а то дествительно ничего не понятно.
Насчет создать лист это тоже не проблема просто нужно понять конкретно что ты хочеш. А то видиш два человека и поразному понимают посталеную задачу.

Исходные ячейки выделял.
Ячейки с текстом и пустые ячейки можно считать за одно и тоже,т.е. там,где я пропускал строку(оставлял пустой) может быть текст...


Коменты,в примере RedPromo вообще удалил..

А как сюда файл выложить???


                            
                                        
0.25
556.0 516.0 0.0 0.0 0.0 104.0 548.0 2956.0 3048.0 572.0 2696.0
0.50
556.0 520.0 0.0 0.0 0.0 144.0 540.0 2956.0 3048.0 572.0 2692.0
0.75
560.0 524.0 0.0 0.0 0.0 128.0 540.0 2956.0 3044.0 572.0 2708.0
1.00
560.0 520.0 0.0 0.0 0.0 148.0 540.0 2956.0 3052.0 572.0 2692.0


Условия запуска : давление Рн = 735.6 мм.рт.ст.; температура в боксе Тн = 0.0 °С         
T= 0.25 c


0.25
3088.0 772.0 756.0 3076.0 0.0 6180.0 6360.0 3192.0 536.0 0.0 4.0
0.50
3088.0 776.0 748.0 3076.0 0.0 6180.0 6356.0 3188.0 528.0 0.0 0.0
0.75
3088.0 772.0 748.0 3080.0 0.0 6184.0 6360.0 3184.0 536.0 0.0 0.0
1.00
3096.0 784.0 752.0 3088.0 0.0 6200.0 6376.0 3200.0 540.0 0.0 0.0


Примерно так...

agrippa
Я так понимаю, это реальные данные.
Во-первых, ты нигде не писал, что у тебя есть другие колонки. Они нужны? Что с ними делать?
Во-вторых, эксель русский или английский? Что есть десятичный разделитель - точка или запятая? Распознаются ли твои ячейки как числовые в экселе (например функцией СУММА)?
Если нет, макрос естественно ничего делать не будет, так как он скипывает текст.

Файл обычно выкладывают через какой-нибудь обменник (только не рапида плиз).


Добавлено:
Пока примерно так. Без остальных столбцов.

Код: Sub MergeCells2()
Dim first As Boolean
Dim newarea As Boolean
Dim row1 As Long, row2 As Long
Dim ur As Range
Dim c As Range
Dim tmpstr As String

first = True
newarea = True
row1 = 1
row2 = 1
Set ur = ActiveSheet.UsedRange.Columns(1).Cells
For Each c In ur
If IsNumeric(c) And Not IsEmpty(c) Then
If newarea Then
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
newarea = False
row1 = 1
row2 = 1
End If
ActiveSheet.Cells(row1, 1).Value = c.Value
row1 = row1 + 1
If first Then
tmpstr = c.Value
first = False
Else
ActiveSheet.Cells(row2, 3).Value = tmpstr & c.Value
first = True
row2 = row2 + 1
End If
Else
newarea = True
End If
Next
End Sub

http://dl.axifile.com/37dd99cae046230aa55ed52cb4ff356f/8575559!.xls

вот ссылка на задание

agrippa
Не получилось скачать.

agrippa
Вам следует постить не ссылку, которую сайт генерит, а то, что Вам сайтом было дано после закачки.

http://195.210.38.23:2082//dl/f51a1bfb2e004ed2238ce72123b1b0f6/44c77b66/files/260706/1153923930/LAR.exe

Там нажать Click Here To Download!


Вроде скачивается...

agrippa
Эта ссылка привязана к сессии на твоем компьютере. Больше ни у кого она не откроется.
После закачки файла сервис должен тебе выдать ссылку, которую можно послать кому угодно. Смотри внимательно.
Жду ответов на мои вопросы. Последний макрос пробовал?

Да,пробовал... Как-то у меня странно работает,не так,как задумано было...

Я может на почту вам скину или на асю,если она у вас есть,Yuk...

Моя ася: 217-355-077
Моя почта:agrip@pochta.ru