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

Вход

Регистрация

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

 

= Мир MS Excel/Проставить значение макросом вместо ВПР - Страница 2 - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 2 из 2«12
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Проставить значение макросом вместо ВПР (Макросы/Sub)
Проставить значение макросом вместо ВПР
amadeus017 Дата: Суббота, 13.02.2016, 20:26 | Сообщение № 21
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Open ThisWorkbook & "\" dictionary.txt For Input As #1 ;Открываем файл на чтение


файл находится в этой папке.
d:\!_Закрытие\01_2016
Когда я его вставляю в код, то выдает ошибку на эту строчку (сноска на цитату) и выделяет слово "dictionary.txt"

Возможно неправильно вставил?
[vba]
Код
Open ThisWorkbook & "d:\!_Закрытие\01_2016" dictionary.txt For Input As #1
[/vba] ;Открываем файл на чтение
[moder]Используйте теги для оформления кода (кнопка #)[/moder]
 
Ответить
Сообщение
Open ThisWorkbook & "\" dictionary.txt For Input As #1 ;Открываем файл на чтение


файл находится в этой папке.
d:\!_Закрытие\01_2016
Когда я его вставляю в код, то выдает ошибку на эту строчку (сноска на цитату) и выделяет слово "dictionary.txt"

Возможно неправильно вставил?
[vba]
Код
Open ThisWorkbook & "d:\!_Закрытие\01_2016" dictionary.txt For Input As #1
[/vba] ;Открываем файл на чтение
[moder]Используйте теги для оформления кода (кнопка #)[/moder]

Автор - amadeus017
Дата добавления - 13.02.2016 в 20:26
StoTisteg Дата: Суббота, 13.02.2016, 21:21 | Сообщение № 22
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
1) Я неправильно написал (исправил, посмотрите)
2) Вы неправильно вставили.
ThisWorkbook.Path — это путь к файлу с макросом, если нужно использовать абсолютный путь (что неудобоваримо, ибо тогда макрос нельзя запускать на другом компе), то ThisWorkbook.Path не нужен:
[vba]
Код

Open "d:\!_Закрытие\01_2016\dictionary.txt" For Input As #1
[/vba]


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение1) Я неправильно написал (исправил, посмотрите)
2) Вы неправильно вставили.
ThisWorkbook.Path — это путь к файлу с макросом, если нужно использовать абсолютный путь (что неудобоваримо, ибо тогда макрос нельзя запускать на другом компе), то ThisWorkbook.Path не нужен:
[vba]
Код

Open "d:\!_Закрытие\01_2016\dictionary.txt" For Input As #1
[/vba]

Автор - StoTisteg
Дата добавления - 13.02.2016 в 21:21
StoTisteg Дата: Суббота, 13.02.2016, 21:26 | Сообщение № 23
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
То есть Вам нужно создать текстовый файл dictionary.txt, поместить его туда, откуда его возьмёт макрос, скопировать путь к нему из адресной строки Проводника и прописать так:
[vba]
Код

Open "<вставить сюда>\dictionary.txt" For Input As #1
[/vba]
Формат текстового файла такой:

Город#Г0001
ДругойГород#Д0002

и т. д. Файл для Вашего примера прилагаю.
К сообщению приложен файл: dictionary.txt(0Kb)


Проверь всё. ThisWorkbook.Save. On Error Resume Next.

Сообщение отредактировал StoTisteg - Суббота, 13.02.2016, 21:32
 
Ответить
СообщениеТо есть Вам нужно создать текстовый файл dictionary.txt, поместить его туда, откуда его возьмёт макрос, скопировать путь к нему из адресной строки Проводника и прописать так:
[vba]
Код

Open "<вставить сюда>\dictionary.txt" For Input As #1
[/vba]
Формат текстового файла такой:

Город#Г0001
ДругойГород#Д0002

и т. д. Файл для Вашего примера прилагаю.

Автор - StoTisteg
Дата добавления - 13.02.2016 в 21:26
Udik Дата: Суббота, 13.02.2016, 21:49 | Сообщение № 24
Группа: Друзья
Ранг: Старожил
Сообщений: 1219
Репутация: 153 ±
Замечаний: 0% ±

Excel 2013
добавить строчку самый дремучий юзер

и накосячить в этом файле такоже может :) .
вот для файла-обработчика код

Правда отлов ошибок лень было прописывать , и функцию GetFileName честно потырил :) strLN2 - имя листа в обрабатываемом файле
К сообщению приложен файл: 0t.xlsb(22Kb) · 0test.xlsx(15Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com


Сообщение отредактировал Udik - Суббота, 13.02.2016, 22:00
 
Ответить
Сообщение
добавить строчку самый дремучий юзер

и накосячить в этом файле такоже может :) .
вот для файла-обработчика код

Правда отлов ошибок лень было прописывать , и функцию GetFileName честно потырил :) strLN2 - имя листа в обрабатываемом файле

Автор - Udik
Дата добавления - 13.02.2016 в 21:49
amadeus017 Дата: Суббота, 13.02.2016, 21:52 | Сообщение № 25
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
То есть Вам нужно создать текстовый файл dictionary.txt, поместить его туда, откуда его возьмёт макрос, скопировать путь к нему из адресной строки Проводника и прописать так:


Делаю так как Вы говорите, но все равно ошибка
К сообщению приложен файл: 5065395.png(24Kb) · 7871507.txt(0Kb)


Сообщение отредактировал amadeus017 - Суббота, 13.02.2016, 21:55
 
Ответить
Сообщение
То есть Вам нужно создать текстовый файл dictionary.txt, поместить его туда, откуда его возьмёт макрос, скопировать путь к нему из адресной строки Проводника и прописать так:


Делаю так как Вы говорите, но все равно ошибка

Автор - amadeus017
Дата добавления - 13.02.2016 в 21:52
buchlotnik Дата: Суббота, 13.02.2016, 21:54 | Сообщение № 26
Группа: Друзья
Ранг: Старожил
Сообщений: 2049
Репутация: 613 ±
Замечаний: 0% ±

2010, 2013, 2016 RUS / ENG
amadeus017, поменяйте точки с запятыми на апострофы (апостроф - символ начала комментария)


платная помощь:
ЯД: 410012595572239; WM: 311017577133
buchlotnik@mail.ru
 
Ответить
Сообщениеamadeus017, поменяйте точки с запятыми на апострофы (апостроф - символ начала комментария)

Автор - buchlotnik
Дата добавления - 13.02.2016 в 21:54
StoTisteg Дата: Суббота, 13.02.2016, 21:57 | Сообщение № 27
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
и накосячить в этом файле такоже может

Может. Но исправить его косяки — копипаст из Экселевского файла +один проход регэкспа :)


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение
и накосячить в этом файле такоже может

Может. Но исправить его косяки — копипаст из Экселевского файла +один проход регэкспа :)

Автор - StoTisteg
Дата добавления - 13.02.2016 в 21:57
StoTisteg Дата: Суббота, 13.02.2016, 21:58 | Сообщение № 28
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
amadeus017, поменяйте точки с запятыми на апострофы (апостроф - символ начала комментария)

Тьфу, блин. прошу пардону, не о том думал :) Поправил.


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение
amadeus017, поменяйте точки с запятыми на апострофы (апостроф - символ начала комментария)

Тьфу, блин. прошу пардону, не о том думал :) Поправил.

Автор - StoTisteg
Дата добавления - 13.02.2016 в 21:58
amadeus017 Дата: Суббота, 13.02.2016, 21:59 | Сообщение № 29
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
поменяйте точки с запятыми на апострофы (апостроф - символ начала комментария)


Я пробовал это делать, но в таком случаи, "ругательство" было на другое слово, и я решил, что не нужно было менять
К сообщению приложен файл: 9547814.png(54Kb)
 
Ответить
Сообщение
поменяйте точки с запятыми на апострофы (апостроф - символ начала комментария)


Я пробовал это делать, но в таком случаи, "ругательство" было на другое слово, и я решил, что не нужно было менять

Автор - amadeus017
Дата добавления - 13.02.2016 в 21:59
StoTisteg Дата: Суббота, 13.02.2016, 22:08 | Сообщение № 30
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Вредно писать код прямо в окно ответа >( Там опечатка — Tnen вместо Then


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеВредно писать код прямо в окно ответа >( Там опечатка — Tnen вместо Then

Автор - StoTisteg
Дата добавления - 13.02.2016 в 22:08
StoTisteg Дата: Суббота, 13.02.2016, 22:23 | Сообщение № 31
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Забыли, кстати, отличить Омск от Омск область... Поправил.


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеЗабыли, кстати, отличить Омск от Омск область... Поправил.

Автор - StoTisteg
Дата добавления - 13.02.2016 в 22:23
amadeus017 Дата: Суббота, 13.02.2016, 22:24 | Сообщение № 32
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Вредно писать код прямо в окно ответа >( Там опечатка — Tnen вместо Then


Поправил так как Вы написали, запустил макрос, в итоге получилось

ноярск#K0309
ноярск#K0309
ноярск#K0309
ноярск#K0309
ноярск#K0309
ноярск#K0309
ноярск#K0309
 
Ответить
Сообщение
Вредно писать код прямо в окно ответа >( Там опечатка — Tnen вместо Then


Поправил так как Вы написали, запустил макрос, в итоге получилось

ноярск#K0309
ноярск#K0309
ноярск#K0309
ноярск#K0309
ноярск#K0309
ноярск#K0309
ноярск#K0309

Автор - amadeus017
Дата добавления - 13.02.2016 в 22:24
amadeus017 Дата: Суббота, 13.02.2016, 22:31 | Сообщение № 33
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
и накосячить в этом файле такоже может :) .
вот для файла-обработчика код


Попробовал воспользоваться Вашим кодом, скачал файлы и запустил макрос. Выдает ошибку
К сообщению приложен файл: 8564771.png(41Kb)
 
Ответить
Сообщение
и накосячить в этом файле такоже может :) .
вот для файла-обработчика код


Попробовал воспользоваться Вашим кодом, скачал файлы и запустил макрос. Выдает ошибку

Автор - amadeus017
Дата добавления - 13.02.2016 в 22:31
amadeus017 Дата: Суббота, 13.02.2016, 22:34 | Сообщение № 34
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
и накосячить в этом файле такоже может :) .
вот для файла-обработчика код


Прошу прощение, работает! Не из того файла запускал макрос!
Буду смотреть на ошибки.
 
Ответить
Сообщение
и накосячить в этом файле такоже может :) .
вот для файла-обработчика код


Прошу прощение, работает! Не из того файла запускал макрос!
Буду смотреть на ошибки.

Автор - amadeus017
Дата добавления - 13.02.2016 в 22:34
StoTisteg Дата: Суббота, 13.02.2016, 22:39 | Сообщение № 35
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Поправил так как Вы написали, запустил макрос, в итоге получилось

Щас гляну...


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
Сообщение
Поправил так как Вы написали, запустил макрос, в итоге получилось

Щас гляну...

Автор - StoTisteg
Дата добавления - 13.02.2016 в 22:39
StoTisteg Дата: Суббота, 13.02.2016, 22:55 | Сообщение № 36
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Нет, больше я прямо в окно не писец даже в простых случаях shock Прошу прощения, вот рабочее и проверенное:
[vba]
Код

Sub CodeForCity()

     Dim i As Long

     For i = 4 To Cells(Rows.Count, 15).End(xlUp).Row
         Cells(i, 18).Value = CityCode(Trim(Cells(i, 15).Value))
         If Val(Cells(i, 14).Value) < 0 Then
             Cells(i, 19).Value = Abs(Val(Cells(i, 14).Value))
             Else
             Cells(i, 20).Value = Val(Cells(i, 14).Value)
         End If
     Next i

End Sub

Private Function CityCode(City As String) As String

     CityCode = ""
     On Error Resume Next
     Open ThisWorkbook.Path & "\dictionary.txt" For Input As #1 'Открываем файл на чтение
     If Err.Number <> 0 Then 'Если у кого-то шаловливые ручки, требуем вернуть всё на место
         MsgBox prompt:="Положи словарь на место и больше не трогай!"
         ThisWorkbook.Close
     End If
     Do While Not EOF(1) 'Крутимся в цикле до конца файла
         Line Input #1, CityCode
         If InStr(1, CityCode, City, vbTextCompare) = 1 And InStr(1, CityCode, "#", vbTextCompare) - 1 = Len(City) Then 'Проверяем, найдена ли нужная строка
             CityCode = Right(CityCode, Len(CityCode) - InStr(1, CityCode, "#", vbTextCompare)) 'Если да, то вырезаем код и выходим из цикла
             Exit Do
                 Else
                     CityCode = "" 'Если нет — сбрасываем возвращаемое значение
         End If
     Loop
     Close #1
     If CityCode = "" Then MsgBox prompt:="Маршрута на " & City & " в списке нет, пополните список!" 'Проверяем, найден ли маршрут

End Function

[/vba]


Проверь всё. ThisWorkbook.Save. On Error Resume Next.

Сообщение отредактировал StoTisteg - Суббота, 13.02.2016, 23:50
 
Ответить
СообщениеНет, больше я прямо в окно не писец даже в простых случаях shock Прошу прощения, вот рабочее и проверенное:
[vba]
Код

Sub CodeForCity()

     Dim i As Long

     For i = 4 To Cells(Rows.Count, 15).End(xlUp).Row
         Cells(i, 18).Value = CityCode(Trim(Cells(i, 15).Value))
         If Val(Cells(i, 14).Value) < 0 Then
             Cells(i, 19).Value = Abs(Val(Cells(i, 14).Value))
             Else
             Cells(i, 20).Value = Val(Cells(i, 14).Value)
         End If
     Next i

End Sub

Private Function CityCode(City As String) As String

     CityCode = ""
     On Error Resume Next
     Open ThisWorkbook.Path & "\dictionary.txt" For Input As #1 'Открываем файл на чтение
     If Err.Number <> 0 Then 'Если у кого-то шаловливые ручки, требуем вернуть всё на место
         MsgBox prompt:="Положи словарь на место и больше не трогай!"
         ThisWorkbook.Close
     End If
     Do While Not EOF(1) 'Крутимся в цикле до конца файла
         Line Input #1, CityCode
         If InStr(1, CityCode, City, vbTextCompare) = 1 And InStr(1, CityCode, "#", vbTextCompare) - 1 = Len(City) Then 'Проверяем, найдена ли нужная строка
             CityCode = Right(CityCode, Len(CityCode) - InStr(1, CityCode, "#", vbTextCompare)) 'Если да, то вырезаем код и выходим из цикла
             Exit Do
                 Else
                     CityCode = "" 'Если нет — сбрасываем возвращаемое значение
         End If
     Loop
     Close #1
     If CityCode = "" Then MsgBox prompt:="Маршрута на " & City & " в списке нет, пополните список!" 'Проверяем, найден ли маршрут

End Function

[/vba]

Автор - StoTisteg
Дата добавления - 13.02.2016 в 22:55
amadeus017 Дата: Суббота, 13.02.2016, 23:16 | Сообщение № 37
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Нет, больше я прямо в окно не писец даже в простых случаях shock Прошу прощения, вот рабочее и проверенное:


Работает, но последняя строка, не заполняется.
В справочнике этот город есть. Пробовал добавлять строки, думал, что может на количество строк ограничение, ай нет, ограничений в строках не было. Все равно, последняя строка пустая.
 
Ответить
Сообщение
Нет, больше я прямо в окно не писец даже в простых случаях shock Прошу прощения, вот рабочее и проверенное:


Работает, но последняя строка, не заполняется.
В справочнике этот город есть. Пробовал добавлять строки, думал, что может на количество строк ограничение, ай нет, ограничений в строках не было. Все равно, последняя строка пустая.

Автор - amadeus017
Дата добавления - 13.02.2016 в 23:16
StoTisteg Дата: Суббота, 13.02.2016, 23:40 | Сообщение № 38
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

Excel 2010
Не заметил, что таблица не с первой строки начинается :) Поправил


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеНе заметил, что таблица не с первой строки начинается :) Поправил

Автор - StoTisteg
Дата добавления - 13.02.2016 в 23:40
amadeus017 Дата: Суббота, 13.02.2016, 23:55 | Сообщение № 39
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Не заметил, что таблица не с первой строки начинается :) Поправил


Теперь все круто!!!!
 
Ответить
Сообщение
Не заметил, что таблица не с первой строки начинается :) Поправил


Теперь все круто!!!!

Автор - amadeus017
Дата добавления - 13.02.2016 в 23:55
amadeus017 Дата: Суббота, 13.02.2016, 23:58 | Сообщение № 40
Группа: Пользователи
Ранг: Новичок
Сообщений: 32
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Хочу выразить свою благодарность участникам этого форума, которые корректировали мои действия и помогли с кодами, а именно:
Udik и StoTisteg

Большое вам человеческое, СПАСИБО!!!!
 
Ответить
СообщениеХочу выразить свою благодарность участникам этого форума, которые корректировали мои действия и помогли с кодами, а именно:
Udik и StoTisteg

Большое вам человеческое, СПАСИБО!!!!

Автор - amadeus017
Дата добавления - 13.02.2016 в 23:58
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Проставить значение макросом вместо ВПР (Макросы/Sub)
Страница 2 из 2«12
Поиск:

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