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

Страницы: 1
Разделить текст по ячейкам по первому пробелу
 
Здравствуйте.
    В приложенном файле в столбце Bесть данные. Мне нужно разбить их по столбцам по первому пробелу, то есть для примера в первой строке должно получиться так: в одной ячейке - 5555, а в другой - 20 шт. Но если в "Текст по столбцам" поставить в качестве разделителя пробел, то текст в моём файле разобьётся на три ячейки по всем пробелам. Как быть? Хотелось бы без использования макросов. Помогите, пожалуйста.
Изменено: vikttur - 13.08.2021 14:17:41
Почему ссылки на изображения на сайте делают файл "тормознутым"?
 
Здравствуйте.
     Имеется файл. в нём занято 10 столбцов и около 4000 строк. В одном столбце находятся кликабельные ссылки на сайт с изображениями (в каждой строке ссылка на конкретное изображение), которые являются рабочими. Но в результате любые действия в файле, как то: копирование/вставка столбцов, удаление большого диапазона данных и вообще любые "телодвижения" с большими диапазонами превращаются в мучительное ожидание каждого такого действия минимум минуту. Скажите, пожалуйста, можно ли что-то сделать, чтобы файл "ворочался" быстрее?
Как отменить сбрасывание копирования при редактировании ячейки?
 
Здравствуйте, уважаемые форумчане.
     В эксель 2016 есть неприятный для меня, по крайней мере, момент: если, скопировав что-то, зайти в ячейку, чтобы в ней что-то ввести/отредактировать, то копирование слетает. Скажите, пожалуйста, можно ли как-то заставить его не слетать?
Как вернуть скрытую ленту?
 
Здравствуйте.
       Случайно скрыл ленту:
       
       Подскажите, пожалуйста, как вернуть?
Почему код выписывает значения через строку?
 
Здравствуйте.
      Есть код:
Скрытый текст

Он ищет в файлах в определённой папке заданное слово и, если находит, выписывает в файл, откуда он запущен, значения соседних ячеек. Но есть один вопрос: почему-то код пишет значения ячеек через строку. Никак не могу понять почему. Во вложении - файл для поиска. Пр нахождении слова в нескольких файлах - пишет через строку. Не знаю, нужно ли мне ещё примеров наделать... Помогите разобраться, пожалуйста.
Почему If при наличии нескольких условий, связанных через Or, обрабатывает только первое?
 
Здравствуйте.
     У меня есть код:
                   
Код
 If Rng.Offset(0, 5).Value <> "Да" Or Rng.Offset(0, 5).Value <> "ДА" Then
                     MsgBox "Значение ячейки " & Rng.Offset(0, 5).Value, vbInformation, "Конец"
                     Exit Sub
                     End If
, где Rng - переменная, значение которой задаётся ранее в коде при выполнении поиска. И в принципе всё работает, кроме: в первой строке указанного кода If проверяет только первое условие. Всё, что после Or, почему-то игнорируется. Подскажите, пожалуйста, почему? И как это исправить?
Изменено: Неопытный_Экселист - 29.06.2021 11:09:32
Сколько раз было найдено заданное слово?
 
Здравствуйте.
    У меня есть код:
   
Код
For Each Sht In WB.Sheets 'цикл по всем листам в файле
        Set Rng = Sht.Cells.Find(d, , xlFormulas, xlWhole) 'xlWhole - ячейка целиком, xlPart - часть ячейки
        If Not Rng Is Nothing Then 'если нашли
           firstAddress = Rng.Address 'запоминаем адрес первой найденной ячейки
           Do
            'MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
                     g = Rng.Row
                     h = Rng.Column
                     'MsgBox "Значение ячейки" & Rng.Offset(0, -3).Value, vbInformation, "Конец"
                     'MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
                     If Rng.Offset(0, 0 + 5).Value <> "Да" Or Rng.Offset(0, 0 + 5).Value <> "ДА" Or Rng.Offset(0, 0 + 5).Value <> "да" Then
                        For i = 1 To Rng
                            If Workbooks(p & f).Sheets(1).Range(g, h) = Workbooks(p & f).Sheets(1).Range("D" & g) Then
                               MsgBox "Значение ячейки " & Rng.Offset(0, -3).Value, vbInformation, "Конец"
                               Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 3, h).Value
                               Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g - 1, h).Value
                               Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 2, h).Value
                               Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
                            ElseIf Range(g, h) = Range("H", h) Then
                               Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 4, h).Value
                               Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g + 1, h).Value
                               Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 4, h).Value
                               Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
                            End If
                            i = i + 1
                        Next i
                    End If
        Set Rng = Sht.Cells.FindNext(Rng) 'ищем следующую ячейку на листе
        Loop Until firstAddress = Rng.Address 'повторяем цикл, пока не вернёмся к первой найденной ячейке
        End If
    Next Sht

   Он ищет в файлах в указанной папке заданное слово. Если нашёл - выполняет действие (пишет в файл, откуда запущен, значения соседних ячеек). Если на листе заданное слово найдено более одного раза - выполняет действие для каждого нахождения. Но мне нужно ещё посчитать, сколько раз он нашёл заданное слово на листе. Подскажите, пожалуйста, как это сделать?
Ошибка Object Variable or With block Variable not set
 
Здравствуйте.
      Есть код:
Код
Sub Найти_документы()
Const AddrresCell = 4
Dim p As String 'Директория файлов
Dim f As String 'Имя файла
Dim s As String 'Имя листа
Dim a As String 'Адрес ячейки
Dim Rng As Range, Sht As Worksheet
Dim i&, g&, h&
'Dim WB As Object
'Вызываем диалоговое окно для определения папки с файлами
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Укажите папку, в которой находятся файлы"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Отменено" 'Прекращение работы
Else
PName = .SelectedItems(1) 'Получение пути
 
'Считаем количество файлов в папке для создания массива названий файлов
FName = Dir(PName & "\*.xls") 'Получаем имя первого файла
FQuant = 0 'обнуляем кол-во файлов
' Цикл подсчета кол-ва файлов
Do Until FName = "" 'Пока имя файла не станет пустым
FQuant = FQuant + 1 'Счетчик кол-ва
FName = Dir 'Получение следующего имени файла
Loop
'Заполняем массив названиями файлов
ReDim arr(1 To FQuant) As String 'Задание размерности массива на основе кол-ва файлов
FName = Dir(PName & "\*.xls") 'Получаем имя первого файла
N = 0 'обнуляем счетчик
' Цикл заполнения массива именами файлов
Do Until FName = "" 'Пока имя файла не станет пустым
N = N + 1 'Счетчик размерности массива
arr(N) = FName 'Заполнение ячейки массива
FName = Dir 'Получение следующего имени файла
Loop
N = 0
'Цикл перебора файлов
d = InputBox("Что ищем?")
If IsNull(d) Then Exit Sub
For N = 1 To FQuant
    p = PName & "\" 'Директория файлов
    f = arr(N) 'получаем имя файла
    s = Left(arr(N), Len(arr(N)) - 5) 'получаем имя листа
    'On Error Resume Next
    Set WB = Application.Workbooks.Open(p & f)
    'Set WB = GetObject(p & f)
    'Workbooks(f).Activate
    For Each Sht In WB.Sheets 'цикл по всем листам в файле
        Set Rng = Sht.Cells.Find(d, , xlFormulas, xlWhole) 'xlWhole - ячейка целиком, xlPart - часть ячейки
        firstAddress = Rng.Address 'запоминаем адрес первой найденной ячейки
        Do
        If Not Rng Is Nothing Then 'если нашли
            'MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
                     g = Rng.Row
                     h = Rng.Column
                     MsgBox "Значение ячейки" & Workbooks(p & f).Sheets(1).Rng.Offset(0, -3).Value, vbInformation, "Конец"
                     'MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
                     If Workbooks(p & f).Sheets(1).Range(g, h + 5).Value <> "Да" Or Workbooks(p & f).Sheets(1).Range(g, h + 5).Value <> "ДА" Or Workbooks(p & f).Sheets(1).Range(g, h + 5).Value <> "да" Then
                        For i = 1 To Rng
                            If Workbooks(p & f).Sheets(1).Range(g, h) = Workbooks(p & f).Sheets(1).Range("D" & g) Then
                               MsgBox "Значение ячейки" & Workbooks(p & f).Sheets(1).Range(g, h - 3).Value, vbInformation, "Конец"
                               Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 3, h).Value
                               Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g - 1, h).Value
                               Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 2, h).Value
                               Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
                            ElseIf Range(g, h) = Range("H", h) Then
                               Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 4, h).Value
                               Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g + 1, h).Value
                               Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 4, h).Value
                               Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
                            End If
                        Next i
                    End If
        End If
        Set Rng = Sht.Cells.FindNext(Rng) 'ищем следующую ячейку на листе
        Loop Until firstAddress = Rng.Address 'повторяем цикл, пока не вернёмся к первой найденной ячейке
    Next Sht
    If Rng Is Nothing Then 'если не нашли
       GoTo Metka
    End If
Metka:
WB.Close
Next N
     If Rng Is Nothing Then 'если не нашли
        MsgBox "Не найдено ни на одном листе!", vbExclamation, "Конец"
     End If
End If
End With
End Sub

     Код ищет заданное слово в файлах в указанной папке (тут всё ок - находит), и затем должен выписать содержимое нескольких ячеек. Или хотя бы MsgBox
Код
MsgBox "Значение ячейки" & Workbooks(p & f).Sheets(1).Rng.Offset(0, -3).Value, vbInformation, "Конец"
показать. Но вместо этого выскакивает ошибка: Ошибка Object Variable or With block Variable not set (см. скрин). Я уже весь мозг сломал, но что-то преодолеть эту ошибку не получается. Помогите, пожалуйста.
Как отобразить в Msgbox значение ячейки?
 
     Здравствуйте.
    Скажите, пожалуйста, как отобразить в Msgbox значение ячейки?
Пробовал так:
Код
MsgBox "Значение ячейки" & Workbooks(Полный путь к книге).Sheets(1).Range(A1).Value, vbInformation, "Конец"
, но никакого окна со значением ячейки не выскакивает? Скажите, пожалуйста, как правильно?
Как заставить макрос выполнять указанное действие столько раз, сколько раз искомое слово встречается на листе
 
      Здравствуйте.
     У меня есть макрос, который ищет в других файлах (всё прописано и работает) указанное слово (через Inputbox)  и найдя его в книге, откуда он был запущен, записывает значения соседних ячеек (соседних с ячейкой книги в которой он нашёл заданное слово). Поиск осуществляется так:
Код
Set Rng = Sht.Cells.Find(d, , xlFormulas, xlWhole)
, где d - это слово, введённое в Inputbox. Проблема в том, что заданное слово может встречаться несколько раз на листе, но макрос обрабатывает только первое нахождение (записывает нужные мне значения соседних ячеек), и дальше идёт искать в другой книге. Как заставить его обработать все нахождения указанного слова на листе?
 
Изменено: Неопытный_Экселист - 25.06.2021 16:55:12
Как прописать макросом в ячейку значение из другой книги?
 
Здравствуйте.
    Скажите, пожалуйста, как правильно в коде прописать, чтобы в ячейку A1 в книге, из которой запускается макрос, было записано значение ячейки из другой книги?
Пытался кодом:
Код
Workbooks(название книги с макромом).Range(A1).Value = Workbooks(полный путь к другой книге).Range(A1).Value
,
но код по факту ничего не делает. Как же правильно это записать? Помогите, пожалуйста.
Макрос поиска в других файлах не берёт из них нужные значения
 
      Здравствуйте, уважаемые форумчане.
     Есть код:
   
Код
Private Function GetValue(path, file, sheet, ref)
Dim arg As String
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "Файл не найден"
Exit Function
End If
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Sub Найти_документы()
Const AddrresCell = 4
Dim p As String 'Директория файлов
Dim f As String 'Имя файла
Dim s As String 'Имя листа
Dim a As String 'Адрес ячейки
Dim Rng As Range, Sht As Worksheet
Dim i&, g&, h&
'Вызываем диалоговое окно для определения папки с файлами
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Укажите папку, в которой находятся файлы"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Отменено" 'Прекращение работы
Else
PName = .SelectedItems(1) 'Получение пути
 
'Считаем количество файлов в папке для создания массива названий файлов
FName = Dir(PName & "\*.xls") 'Получаем имя первого файла
FQuant = 0 'обнуляем кол-во файлов
' Цикл подсчета кол-ва файлов
Do Until FName = "" 'Пока имя файла не станет пустым
FQuant = FQuant + 1 'Счетчик кол-ва
FName = Dir 'Получение следующего имени файла
Loop
'Заполняем массив названиями файлов
ReDim arr(1 To FQuant) As String 'Задание размерности массива на основе кол-ва файлов
FName = Dir(PName & "\*.xls") 'Получаем имя первого файла
N = 0 'обнуляем счетчик
' Цикл заполнения массива именами файлов
Do Until FName = "" 'Пока имя файла не станет пустым
N = N + 1 'Счетчик размерности массива
arr(N) = FName 'Заполнение ячейки массива
FName = Dir 'Получение следующего имени файла
Loop
N = 0
'Цикл перебора файлов
d = InputBox("Что ищем?")
If IsNull(d) Then Exit Sub
For N = 1 To FQuant
    p = PName & "\" 'Директория файлов
    f = arr(N) 'получаем имя файла
    s = Left(arr(N), Len(arr(N)) - 5) 'получаем имя листа
    On Error Resume Next
    Set WB = Application.Workbooks.Open(p & f)
    With GetObject(p & f)
    For Each Sht In WB.Sheets 'цикл по всем листам в файле
        Set Rng = Sht.Cells.Find(d, , xlFormulas, xlWhole) 'xlWhole - ячейка целиком, xlPart - часть ячейки
        If Not Rng Is Nothing Then 'если нашли
            'MsgBox "Найдено на листе " & Rng.Parent.Name & " в ячейке " & Rng.Address(0, 0), vbInformation, "Конец"
            For Each Cell In Rng
                     g = Rng.Adress.Row
                     h = Rng.Adress.Column
                     If Range(g + 5, h).Value <> "Да" Or Range(g + 5, h).Value <> "ДА" Or Range(g + 5, h).Value <> "да" Then
                        For i = 1 To Rng
                            If Range(g, h) = Range("D", h) Then
                               MsgBox (Workbooks(f).Range(g - 3, h).Value)
                               Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 3, h).Value
                               Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g - 1, h).Value
                               Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 2, h).Value
                               Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
                            ElseIf Range(g, h) = Range("H", h) Then
                               Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 4, h).Value
                               Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g + 1, h).Value
                               Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 4, h).Value
                               Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
                            End If
                        Next i
                    End If
            Next Cell
        End If
    Next Sht
    End With
    If Rng Is Nothing Then 'если не нашли
       GoTo Metka
    End If
Metka:
WB.Close
Next N
     If Rng Is Nothing Then 'если не нашли
        MsgBox "Не найдено ни на одном листе!", vbExclamation, "Конец"
     End If
End If
End With
End Sub
Однако почему-то кусок кода
Код
For Each Cell In Rng                     g = Rng.Adress.Row
                     h = Rng.Adress.Column
                     If Range(g + 5, h).Value <> "Да" Or Range(g + 5, h).Value <> "ДА" Or Range(g + 5, h).Value <> "да" Then
                        For i = 1 To Rng
                            If Range(g, h) = Range("D", h) Then
                               MsgBox (Workbooks(f).Range(g - 3, h).Value)
                               Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 3, h).Value
                               Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g - 1, h).Value
                               Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 2, h).Value
                               Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
                            ElseIf Range(g, h) = Range("H", h) Then
                               Workbooks("Поиск.xlsm").Range("B" & i).Value = Workbooks(f).Range(g - 4, h).Value
                               Workbooks("Поиск.xlsm").Range("C" & i).Value = Workbooks(f).Range(g + 1, h).Value
                               Workbooks("Поиск.xlsm").Range("D" & i).Value = Workbooks(f).Range(g + 4, h).Value
                               Workbooks("Поиск.xlsm").Range("E" & i).Value = Workbooks(f).Range(g + 3, h).Value
                            End If
                        Next i
                    End If
            Next Cell
        End If
    Next Sht

не отрабатывает. Помогите, пожалуйста.
Изменено: Неопытный_Экселист - 25.06.2021 14:11:11
Страницы: 1
Наверх