Выбрать дату в календареВыбрать дату в календаре

Страницы: 1 2 След.
Как выделить ячейки содержащие текстовые данные и/или все заполненые ячейки?
 
Мне подошло:
Код
ActiveSheet.Cells.SpecialCells(xlTextValues).Select
Удалить указанное слово из текста
 
Разбираюсь с этим решением:
https://docs.microsoft.com/ru-ru/office/vba/api/excel.range.specialcells
Как выделить ячейки содержащие текстовые данные и/или все заполненые ячейки?
 
Спасибо
Как выделить ячейки содержащие текстовые данные и/или все заполненые ячейки?
 
Здравствуйте
Подскажите пожалуйста, как выделить ячейки содержащие текстовые данные и/или все заполненые ячейки?

В моем excel файле обычно используеться диапазон ячеек B2:D101, но этот диапазон порой значительно изменяеться, как по столбцам так и по строкам.
Данный вопрос встал с целью уменьшения количества операций и автоматизации процесса.
Это необходимо для работы с  макроссами которые ориентированы на обработку выделенных диапазонов.
К примеру
Код
 For Each Cell In Selection 
Next

Пробовал через "Найти" с фильтром * и потом выделить все результаты , но это макросом не пишеться и мне кажеться, что может даже не полноценно работать.

Удалить указанное слово из текста
 
Всем Спасибо.

С кодом разобрался.
Под этот код и не только хотелось бы чтоб был код который выделял все заполненые ячейки (данными).
Удалить указанное слово из текста
 
Ігор Гончаренко Спасибо
Удалить указанное слово из текста
 
Под любым символом я подразумеваю все кроме букв и цифр. К символам отнесем пробелы , запятые , точки с запятой, возможно табуляции и тд.

Ігор Гончаренко Спасибо
Удалить указанное слово из текста
 
Как тогда это лучше реализовать не за один проход, но с учетом того что перед словом и после может быть любой символ?
Удалить указанное слово из текста
 
Здравствуйте
Подскажите пожалуйста как удалить уникальное слово за одну попытку (используя диалоговое окно "Заменить") так, чтобы оно удалялось как целое, а не как часть другого слова
?
Если использовать пробелы с обеих сторон слова, то я не знаю как мне удалить тогда слова вначале и в конце, да так чтоб не зацепить другие слова.
К примеру необходимо удалить слово:
in
в тексте:
interface bookinbook runin interface,bookinbook,runin interface;bookinbook;runin In book  of library Book in list
Our place in In,book,of,library Book,in,list Our,place,in In;book;of;library Book;in;list Our;place;in
должно получиться:
interface bookinbook runin interface,bookinbook,runin interface;bookinbook;runin book  of library Book list Our place book,of,library Book,list Our,place book;of;library
Book;list Our;place
Как удалить отдельные слова на листе из фразы, что задаеться?
 
В моем случае вместо слов tag1 tag2 tag3 tag4 tag5 будут использоваться и другие уникальные слова.
Как удалить отдельные слова на листе из фразы, что задаеться?
 
Думаю да. Буду писать макрос.
Как удалить отдельные слова на листе из фразы, что задаеться?
 
Была мысль, о том что бы использовать регулярные выражения вместе с диалоговым окном "Найти и заменить", но vikttur пишет, что диалоговое окно "Найти и заменить" для этой цели не получиться использовать.
Как удалить отдельные слова на листе из фразы, что задаеться?
 
вместо фразы:
tag1 tag2 tag3 tag4 tag5
может быть любая другая фраза по типу:
image black color set

Я как раз и хотел чтобы решение было не с помощью формулы и макроса , но как понимаю придеться писать макрос.
Как удалить отдельные слова на листе из фразы, что задаеться?
 
Может тогда есть решение кроме, как через диалоговом окно "Найти и заменить"?
Как удалить отдельные слова на листе из фразы, что задаеться?
 
Подскажите пожалуйста,
как удалить отдельные слова на листе из фразы, что задаеться?
Есть фраза:
tag1 tag2 tag3 tag4 tag5
необходимо что б каждое слово tag1, tag2, tag3, tag4, tag5 на листе было удалено.
Перед  tag1, tag2, tag3, tag4, tag5 стоят пробелы которые участвуют в замене.

Возможно ли это реализовать в диалоговом окне "Найти и заменить"?
Изменено: seregasss435 - 18.12.2021 17:15:21
Как сохранить через диалоговое окно "Сохранить как" чтобы csv файл имел разделитель запятую, а не точку с запятой?
 

Ігор Гончаренко, СПАСИБО

sokol92,Спасибо, данный код работает.

При выше изложенных обстаятельствах я прихожу к выводу, что код vba я оставляю в покое и в случае необходимости в ручном режиме необходимо будет просто переключаться в региональных стандартах.

Всем большое спасибо за участие .

Как сохранить через диалоговое окно "Сохранить как" чтобы csv файл имел разделитель запятую, а не точку с запятой?
 
БМВ, Спасибо
Как сохранить через диалоговое окно "Сохранить как" чтобы csv файл имел разделитель запятую, а не точку с запятой?
 
Возможно ли автоматом из кода vba менять значения "Региональных стандартов" и потом возвращать обратно?
Если нет можно было бы создать исполнительный файл, который будет производить изменение параметров и вызываться будут из того кода vba.
Как сохранить через диалоговое окно "Сохранить как" чтобы csv файл имел разделитель запятую, а не точку с запятой?
 
andylu, Спасибо . Работает как надо
Как сохранить через диалоговое окно "Сохранить как" чтобы csv файл имел разделитель запятую, а не точку с запятой?
 
Screen Региональных стандартов После перезагрузки компьютера и Excel данные изменения ни к чему не привели.
Я там где надо менял?
Как сохранить через диалоговое окно "Сохранить как" чтобы csv файл имел разделитель запятую, а не точку с запятой?
 
ScreenMenuExcel
Как сохранить через диалоговое окно "Сохранить как" чтобы csv файл имел разделитель запятую, а не точку с запятой?
 
Здравствуйте

Помогите пожалуйста разобраться:
Я импортирую из csv файла где разделители запятые  (Данные -- Из Текста -- Импорт текстового файла ) данные на лист Excel ,
а затем когда сохраняю как csv (разделители запятые), то он сохраняеться с разделителями точка с запятой хотя в
"Параметры Excel-Дополнительно-Использовать системные разделители-Разделитель целой и дробной части" стоит запятая- тестировал с и без галочки - "Использовать системный разделитель".
Если сохранять макросом тогда будет запятая разделителем, но мне надо иметь возможноть вручную сохранять используя диалоговое окно "Сохранить как" и чтоб в csv был разделить запятая,
а не точка с запятой.
Как сохранить руками чтобы csv имел разделитель запятую?
Notapad запускаемый с VBA Excel кода , не видит создаваемого в Excel файла csv и сохраненного в папке
 
1 Мне необходимо , чтобы на выходе получился csv  следующего вида:
filenam1.jpg,title1,description1,"keywords1,keyword2,keyword3" - тоесть разделители запятые , а там где ключевые слова , то заключение в кавычки
этого получаеться достигнуть если создать Excel где в отдельных столбцах:
filenam1.jpg,
title1,
description1,
"keywords1,keyword2,keyword3"


для этого я сохраняю с разделителями точка с запятой , и так как точка с запятой находиться в ключевых словах они помещаются в кавычки.
Вы мне подали идею , как изменить весь процесс , но для этого мне надо все протестить
Notapad запускаемый с VBA Excel кода , не видит создаваемого в Excel файла csv и сохраненного в папке
 
А как с Excel открыть Notepad с нужным мне файлом и запустить макрос Notepad , сохранить в Notepad и закрыть?
Notapad запускаемый с VBA Excel кода , не видит создаваемого в Excel файла csv и сохраненного в папке
 
Здравствуйте

Помогите пожалуйста решить проблемы(у):

При использование оператора SendKeys у него как я понимаю низкий приоритет и он выполняеться в последнюю очередь :
Application.SendKeys "^w~~" - для закрытия книг лист которых редактировался выполняеться не в том месте в коде где прописан, а в конце .
Получаеться что макрос выполняеться до конца, а потом в конце только книги закрываються, что и имеет право на существование,
но только до той поры пока я не вызываю Notepad для выполнения в нем макроса. Notepad не видит файл который создан поточным
кодом. От SendKeys "^w~~" не могу отказаться так как мне необходимо чтобы csv файл сохранялся с разделителями точка с запятой(;;;";" а не ,,,;).
Код
Sub PlanetaExcel()
' Make "D" the current drive:
    ChDrive "D"

'смена текущего каталога на :
    ChDir "D:\TestTableQuery"

' Создание нового листа
    Workbooks.Add

   'Переменная пути к импортируемому файлу:
    Dim filePathCSV

'Рабочий код Вызова диалогового для пользовательского выбора файла и возврата значения для переменной
filePathCSV = Application.GetOpenFilename("CSV files(*.csv),*.csv", 1, "Выбрать файл CSV", , False)

' Условие проверки выбран ли файл и если не выбран то выполняеться команда выхода из процедуры:
If VarType(filePathCSV) = vbBoolean Then
    Exit Sub
End If

' Создание объекта - таблица запроса - импорт с файла данных для

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & filePathCSV, Destination:=Range("$A$1"))
        .Name = "testfile.csv"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

       ' Do not display the message about overwriting the existing file.
       Application.DisplayAlerts = False

'Количество всех символов
Dim AllCharacters As Long
AllCharacters = Len(filePathCSV)

'Количество всех символов без слеша
Dim AllCharWithOutSlash As Long
AllCharWithOutSlash = Len(Replace(filePathCSV, "\", ""))

'Количество слешей в пути - что тоже что и последний слеш
Dim NSlashs As Long
NSlashs = AllCharacters - AllCharWithOutSlash

'Номер слеша с лева на право который будет третим с правой стороны , что определяет родительскую папку
Dim NSlashL As Long

If NSlashs > 2 Then
NSlashL = NSlashs - 2
ElseIf NSlashs = 2 Then
NSlashL = 2
ElseIf NSlashs = 1 Then
NSlashL = 1
End If

' Позиция (предпоследнего)слеша родительской папки импортируемого файла:
Dim NPosition As Long
NPosition = InStr(Application.WorksheetFunction.Substitute(filePathCSV, "\", "^", NSlashL), "^")

' Позиция последнего слеша в пути к файлу :
Dim NPositionEnd As Long
NPositionEnd = InStr(Application.WorksheetFunction.Substitute(filePathCSV, "\", "^", NSlashs), "^")
'******************************************************************
'Создание файла ExcelCore:
'Проверка на наличие папки с одинаковым именем и если нету одноименной папки, то создаеться новая папка TestExcel:
If Dir(Left(filePathCSV, NPosition) & "TestExcel\", vbDirectory) = "" Then
          MkDir Left(filePathCSV, NPosition) & "TestExcel\"
          End If

   'Сохранение файла с нужным именем в нужную папку
ActiveWorkbook.SaveAs FileName:=Left(filePathCSV, NPosition) & "TestExcel\" & Replace(Mid(filePathCSV, NPositionEnd + 1), ".csv", "ExcelCore.xlsx")

   'Альтернативный код : Close the workbook by using the following.
       ActiveWorkbook.Close
'******************************************************************
' Открытие ExcelCore; запуск макроса по подготовке с ExcelCore csv файла для Folder1

   Workbooks.Open FileName:= _
        Left(filePathCSV, NPosition) & "TestExcel\" & Replace(Mid(filePathCSV, NPositionEnd + 1), ".csv", "ExcelCore.xlsx") _
        , Origin:=xlWindows

' Запуск макроса по подготовке с ExcelCore csv файла для Folder1- для теста необязателен::
'    Application.Run "PERSONAL.XLSB!Folder1ForSvg"

    'Проверка на наличие папки с одинаковым именем и если нету одноименной папки, то создаеться новая папка:
If Dir(Left(filePathCSV, NPosition) & "8__________Folder1\", vbDirectory) = "" Then
          MkDir Left(filePathCSV, NPosition) & "8__________Folder1\"
          End If

    ActiveWorkbook.SaveAs FileName:= _
        Left(filePathCSV, NPosition) & "8__________Folder1\" & Replace(Mid(filePathCSV, NPositionEnd + 1), ".csv", "") & "Folder1.csv", FileFormat:= _
        xlCSV, CreateBackup:=False, local:=False

'******************************************************************
' Открытие ExcelCore; запуск макроса по подготовке с ExcelCore csv файла для Folder2

   Workbooks.Open FileName:= _
        Left(filePathCSV, NPosition) & "TestExcel\" & Replace(Mid(filePathCSV, NPositionEnd + 1), ".csv", "ExcelCore.xlsx") _
        , Origin:=xlWindows

        'Не работает для исправления ошибки связаной с запятой:
'        , Semicolon:=True
'''        , DataType:=xlDelimited,
'''        Local:=True

' Запуск макроса по подготовке с ExcelCore csv файла для Folder2- для теста необязателен:
'Application.Run "PERSONAL.XLSB!l_____Folder2_prepair_CSV"

'Проверка на наличие папки с одинаковым именем и если нету одноименной папки, то создаеться новая папка:
If Dir(Left(filePathCSV, NPosition) & "4__________Folder2_csv\", vbDirectory) = "" Then
          MkDir Left(filePathCSV, NPosition) & "4__________Folder2_csv\"
          End If

    ActiveWorkbook.SaveAs FileName:= _
        Left(filePathCSV, NPosition) & "4__________Folder2_csv\" & Replace(Mid(filePathCSV, NPositionEnd + 1), ".csv", "") & "Folder2.csv", _
        FileFormat:=xlCSV, _
        CreateBackup:=False, _
        local:=False
'******************************************************************
' Открытие ExcelCore; запуск макроса по подготовке с ExcelCore csv файла для Folder3

   Workbooks.Open FileName:= _
        Left(filePathCSV, NPosition) & "TestExcel\" & Replace(Mid(filePathCSV, NPositionEnd + 1), ".csv", "ExcelCore.xlsx") _
        , Origin:=xlWindows

' Запуск макроса по подготовке с ExcelCore csv файла для Folder3- для теста необязателен::
'    Application.Run "PERSONAL.XLSB!l_____Folder3_prepair_CSV"

    'Проверка на наличие папки с одинаковым именем и если нету одноименной папки, то создаеться новая папка:
If Dir(Left(filePathCSV, NPosition) & "3__________Folder3_csv\", vbDirectory) = "" Then
          MkDir Left(filePathCSV, NPosition) & "3__________Folder3_csv\"
          End If

    ActiveWorkbook.SaveAs FileName:= _
        Left(filePathCSV, NPosition) & "3__________Folder3_csv\" & Replace(Mid(filePathCSV, NPositionEnd + 1), ".csv", "") & "Folder3.csv", FileFormat:= _
        xlCSV, CreateBackup:=False, local:=False
'******************************************************************
' Открытие ExcelCore; запуск макроса по подготовке с ExcelCore csv файла для Folder4
   Workbooks.Open FileName:= _
        Left(filePathCSV, NPosition) & "TestExcel\" & Replace(Mid(filePathCSV, NPositionEnd + 1), ".csv", "ExcelCore.xlsx") _
        , Origin:=xlWindows

' Запуск макроса по подготовке с ExcelCore csv файла для Folder4 - для теста необязателен:
'    Application.Run "PERSONAL.XLSB!l_____Folder4_prepair_CSV"

    'Проверка на наличие папки с одинаковым именем и если нету одноименной папки, то создаеться новая папка:
If Dir(Left(filePathCSV, NPosition) & "6__________Folder4\", vbDirectory) = "" Then
          MkDir Left(filePathCSV, NPosition) & "6__________Folder4\"
          End If

    ActiveWorkbook.SaveAs FileName:= _
        Left(filePathCSV, NPosition) & "6__________Folder4\" & Replace(Mid(filePathCSV, NPositionEnd + 1), ".csv", "") & "Folder4.csv", FileFormat:= _
        xlCSV, CreateBackup:=False, local:=False
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV
' Открытые книги при таком коде не закрываються если указан явно адресс для  Notepad или если указан или относительный путь как ниже то Notepad
Application.SendKeys "^w~~"
Application.SendKeys "^w~~"
Application.SendKeys "^w~~"
Application.SendKeys "^w~~"
Application.SendKeys "^w~~"

 Dim res As Variant
    Dim fileToOpen As String
    Dim nppPath As String

    fileToOpen = Left(filePathCSV, NPosition) & "Folder4\" & Replace(Mid(filePathCSV, NPositionEnd + 1), ".csv", "") & "Folder4.csv"
    MsgBox fileToOpen, , "Title file Path"
    nppPath = "C:\Program Files\Notepad++\notepad++.exe"

    res = Shell(nppPath & " " & fileToOpen, vbNormalFocus)

'На этом этапе возникает ошибка Notepad о том что файла не существует хотя в папке смотрю файл есть
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' VVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVVV

Application.SendKeys ("%a") ' --- запуск макроса в Notepad++
Application.SendKeys ("^s") ' --- сохранение изменений в открытом файле
Application.SendKeys ("%{F4}") '--- закрытие программы
    
 ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! всего будет создаваться 4 файла, но для простоты теста пока указываем один
End Sub
Изменено: vikttur - 30.09.2021 10:13:05
Сохранение файла в создаваемую новую папку что будет находиться в родительской папке файла импорта и с названием от импортируемого файла.
 
bigorq, СПАСИБО - РАБОТАЕТ КАК НАДО
Сохранение файла в создаваемую новую папку что будет находиться в родительской папке файла импорта и с названием от импортируемого файла.
 
Ігор Гончаренко, нету аналогичного файла и папки новой тоже нету в которой он бы был

Мой код , если я правильно понимаю ActiveWorkbook.path воспринимает как Default , а попытавшись проверить что же в ActiveWorkbook.path через MsgBox(ActiveWorkbook.path) , то вижу следующее:
Изменено: vikttur - 22.09.2021 19:20:15
Сохранение файла в создаваемую новую папку что будет находиться в родительской папке файла импорта и с названием от импортируемого файла.
 
Получаю вот такую ошибку и файл не сохраняет
 
Изменено: vikttur - 22.09.2021 19:19:02
Сохранение файла в создаваемую новую папку что будет находиться в родительской папке файла импорта и с названием от импортируемого файла.
 
Здравствуйте

Как используя код VBA сохранить файл после выполнения импорта данных с указанного пользователем файла в папку которая являеться родительской для папки
в которой находиться файл для импорта данных (D:\TestTableQuery\testfile.csv- путь к файлу что содержит данные для импорта; D:\TestTableQuery\ - этот путь изменяеться(динамичен))    
там создать новую папку с названием Import1 и в нее сохранить файл excel с именем которое будет состоять из названия файла что выбирался пользователем для импорта и слов ExcelCore,
тоесть его название должно быть в данном случае testfileExcelCore, а путь сохранения  D:\Import1\testfileExcelCore.xlsx ?
Код
Sub TestTableQuary4()

' Make "D" the current drive
    ChDrive "D"

'смена текущего каталога на :
    ChDir "D:\TestTableQuery"

' Создание нового листа
    Workbooks.Add
    
Dim filePathCSV
filePathCSV = Application.GetOpenFilename("CSV files(*.csv),*.csv", 1, "Выбрать файл CSV", , False)

If VarType(filePathCSV) = vbBoolean Then
    Exit Sub
End If

With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & filePathCSV, Destination:=Range("$A$1"))
  
'        .CommandType = 0
        .Name = "testfile.csv"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

       ' Do not display the message about overwriting the existing file.
       Application.DisplayAlerts = False

       'Рабочий старый код:
'       ActiveWorkbook.SaveAs FileName:="D:\TestSave\" & MyFile
 
       ' Тестовый код:
       ActiveWorkbook.SaveAs FileName:="D:\TestSave\ExcelCore"

       ' Close the workbook by using the following.
       ActiveWorkbook.Close
End Sub
Изменено: vikttur - 22.09.2021 19:18:23
Использование окна выбора файла для использования пути к методу QueryTables.Add
 
Дмитрий(The_Prist) Щербаков,Спасибо.  Работает.

Не работало у меня изза того что сделать ошибку в коде
Страницы: 1 2 След.
Наверх