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

Страницы: 1 2 След.
Отключение двойного пересчета формул по условию
 
Спасибо, вроде стало лучше, как то быстрее получается, плюс еще добавил Application.ScreenUpdating = False, не видно двойного пересчета. Спасибо
Отключение двойного пересчета формул по условию
 
Здравствуйте. Есть макрос, который при изменении текста в ячейке A1 (тут выпадающий список из 2 значений) например на "English", в ячейке C1 проставляет 120. Но проблема в том, что Excel дважды пересчитывает формулы: 1 раз - после изменения в ячейке A1, 2-ой раз - после того как макрос проставил в ячейку C1 значение 120. На листе и в книге вцелом много формул, которые подвязаны на эти ячейки, соответственно файл достаточно тормозит при пересчете, а тут так 2 раза. Подскажите, пожалуйста, можно ли решить проблему с пересчетом. Отключать пересчет при открытии файла нельзя, так как не всегда пользователь должен выбирать что то в ячейке А1, а может делать другие действия и формулы также должны пересчитаться. Заранее спасибо


Код
  Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)


  If Not Intersect(Target, Range("A1")) Is Nothing Then
    
 
      If InStr(1, Range("A1"), "English") > 0 Then
        Range("C1").Value = "120"
      End If
      
      If InStr(1, Range("A1"), "German") > 0 Then
        Range("C1").Value = "90"
      End If
  
  End If

End Sub
Проблемма с переменной, не находит такое же значение в названии вкладки
 
Спасибо большое. Заменил и заработало, оказалось все просто. Next не скопировал с Excel. Возможно код не идеальный и нарушены правила "хорошего тона", но спросить некого, и сам далеко не профессионал. Не подскажите что именно здесь криво и надо заменить?
Проблемма с переменной, не находит такое же значение в названии вкладки
 
Помоготе пожалуйста, заблудился в 3 соснах.
С основного файла нахожу другой файл с вкладками, там 20 вкладок, вкладка называется фамилией клиента. Не повторяется. Макросом вытягиваю список листов, и прохожусь по этому списку до конца. В коде задаю переменную для названия листа (название клиента). В окне Locals переменная задается, но не находит листа с таким же названием чтоб скопировать. Хотя список макросом формируется из этих же листов. Ниже код, чтоб было понятнее. Пример названия первого клиента - 987 ПАТ "МЕХАТРОНИК"

Где я делаю не так? В окне Locals - переменная принимает значение 987 ПАТ "МЕХАТРОНИК", но найти вкладку в другом файле с таким названием не могу.

Код
Sub copycliensdata()

On Error Resume Next
Dim Data1folder, Data2folder
Dim oFD As FileDialog
Dim Myfile_Name, NewFile_Name As Variant
Dim mySh As Worksheet, ws As Worksheet
Dim Wbk As Workbook
Dim i As Long
Dim x&, Numrows&
Dim client$


        Data1folder = Application.GetOpenFilename _
                ("Excel files(*.xls*),*.xls*", 1, "Выбрать файл", , False)   'здесь выбираю файл где есть 20 вкладок, каждая вкладка с названием клиента
        If VarType(Data1folder) = vbBoolean Then
            Exit Sub
        End If



        With Workbooks.Open(Data1folder)                                               'формирую список клиентов
            For i = 1 To .Sheets.Count
                ThisWorkbook.Sheets("Macros").Cells(i, 10).Value = .Sheets(i).Name 'список клиентов
            Next
        End With

        Windows("Основной_файл.xlsb").Activate
        Numrows = Workbooks("Основной_файл.xlsb").Sheets("Macros").Range("J1", Range("J1").End(xlDown)).Rows.Count ' диапазон клиентов
            For x = 1 To Numrows
            With Worksheets("Macros")
                client = .Cells(x, 10).Value 'первый клиент из списка, 1-ый клиент с названием 987 ПАТ "МЕХАТРОНИК"
            End With

        Workbooks(Data1folder).Worksheets(client).Range("A1:B200").Copy   ' Здесь не находит клиента с названием 987 ПАТ "МЕХАТРОНИК" которое в переменной client
                                                                           А сам список формируется из названий тех же листов!!!!!
        Windows("Основной_файл.xlsb").Activate

       Sheets("Calculation").Select
        Cells.Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        ActiveSheet.Paste
        Application.CutCopyMode = False


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

Книга 1(расчетный файл, здесь макрос), Лист4 в диапазоне А1:A21 название клиентов. Нужно взять название клиента из A1,зайти в заданную папку (нужно задать один раз для всего цикла) где лежит Книга2 у которой есть 20 вкладок, нужно найти вкладку с названием из ячейки А1. Скопировать данные с этой вкладки в Книгу1, Лист1. Второй шаг. Найти опять клиента по названию с ячейки А1 в заданной папке файл (задать путь 1 раз для всего цикла), открыть файл, скопировать вкладку (она там одна) и вставить данные в Книгу1 Лист2. Третий шаг. Перейти в расчетном файле (куда скопировали 2 вкладки) на Лист 3, пересчитать все формулы. Сохранить эту одну вкладку в заданной папке (также задать путь для всего цикла) с названием с ячейки А1, и переименовать вкладку на название с А1, обрезать связи, сохранить и перейти к 2 клиенту в ячейке А2 и так по всем клиентам. У нас есть 1 расчетный файл, путь 1 где лежит 1 файл у которого есть 20 вкладок (по одной вкладке на клиента), путь 2, где лежат 20 файлов с названиями клиентов (в каждом файле только 1 вкладка), путь 3 где нужно сохранить результат, только 1 вкладку с названием из ячейки. В конце в папке по пути 3 должно быть 20 файлов.

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

Код
On Error Resume Next
Dim sFolder As String, sFiles As String
Dim MSdatafile


Data1Folder$ = GetFolder(1, , "Виберите папку с файлом")          ' путь 1 папка гдележит 1 файл у которого 20 вкладок
If InvoiceFolder$ = "" Then MsgBox "Не выбрано", vbCritical, "Завершено": Exit Sub

Data2Folder$ = GetFolder(1, , "Виберите папку с файлами")          ' путь 2
If InvoiceFolder$ = "" Then MsgBox "Не выбрано", vbCritical, "Завершено": Exit Sub

Data3Folder$ = GetFolder(2, , "Виберите папку куда сохранять файлы") ' путь 3
    If ArchieveFolder$ = "" Then MsgBox "Папка не задана", vbCritical, "Завершено": Exit Sub
Set sht = book.Sheets(

Numrows = Range("E2", Range("E2").End(xlDown)).Rows.Count ' диапазон названия клиентов
 
For x = 1 To Numrows
With sht
   
    arr = .Range(.Cells(2, 1), Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
End With


'-----------------------ШАГ ОДИН-----------------------
'Data1Folder$ тут лежит 1 файл где есть 20 вкладок, найти владку с названием из ячейки A1
Workbooks("Книга2.xlsx").Worksheets("Клиент1").Range("A1:T200").Copy  ' тут нужно сделать цикл а не жестко привязать название клиента
Windows("Книга1.xlsm").Activate                                 ' книга в которую копируем, расчетный файл
Sheets("Лист1").Select                                          ' вкладка куда копируем данные
Cells.Select                                                          ' диапазон куда копируем
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False                                     ' вставляем только значения
    ActiveSheet.Paste
Application.CutCopyMode = False                                       ' отменить выделенный диапазон


'-----------------------ШАГ ДВА-----------------------

    
' выбрать папку Data2Folder$ тут лежит 20 файлов из названиями. Нужно найти файл с названием из ячейки А1

Set wb = Application.Workbooks.Open(sFolder & sFiles)                 'здесь скорее всего неправильно
wb.Sheets(1).Range("A1:T200").Copy
Workbooks("Книга1.xlsm").Worksheets("Лист2").Range("A1").PasteSpecial Paste:=xlPasteValues ' куда копируем
Application.CutCopyMode = False                                       ' отменить выделенный диапазон
wb.Close True                                                         'закрыть файл откуда скопировали данные
        sFiles = Dir


'-----------------------ШАГ ТРИ-------------------------------
Windows("Книга1.xlsm").Activate                                 ' 
Sheets("Лист3").Select
Application.Calculate                 ' пересчитываем все формулы в Книге1
Data3Folder$ 'сюда сохраняем Лист3, с названием из ячейки А1, переименовываем Лист1 также на название с ячейки А1, обрываем связи
Workbooks("Книга1.xlsm").Worksheets("Лист3").SaveCopyAs Path & Имя_для_сохранения & ".xlsx" ' сохраняем 

Конец цикла, переходим к ячейке А2, делаем все то же, до конца списка клиентов.

End Sub
Копирование данных с таблицы по условию с другой таблицы
 
Спасибо всем, первый вариант работает, второй вариант сегодня попробую, уверен тоже сработает. Спасибо всем. С наступающими праздниками.
Копирование данных с таблицы по условию с другой таблицы
 
Здравствуйте, пытаюсь написать макрос для копирования по условию, вроде все просто но не совсем. Есть большая база данных с клиентами и их email, столбец 1-email, 2- фамилия, 3-образование, 4-опыт работы, итого 8 столбцов. Email повторяются, если у человека 3 предыдущих работы, то будет 3 строки, с одинаковым email в 1 столбце. Есть список email от руководства, выбрать клиентов по этому списку, с всеми строками с одинаковым email. То есть, если из списка руководства email совпадает с базой клиентов, то скопировать все строки с одинаковім email на другой лист. База данных 60 тыс строк, список от руководства - 400 email. Итог может получится 900 строк (400 адресов, у каждого по 2-3 образования или 2-3 предыдущих работы). В приложении образец. Data - большой список данных на 60 тыс строк, Запрос - список адресов от руководства, Result - пример, что должно из этого получится. Спасибо
Выбор диапазона ячеек по двум условиям
 
Все, понял, в указанном диапазоне не было "Итого", спасибо вам большое, сделал и первый и второй способ, все работает! С функциями With и End with еще не умею особо работать. Всем спасибо
Выбор диапазона ячеек по двум условиям
 
Здравствуйте, нужно выбрать диапазон, границы которого будут определятся с помощью значения ячеек на листе Позиции ячеек могут быть разными но в диапазоне А1:Н100. Например Этап 1.Ищем позицию слова "начало" - это левая верхняя граница диапазона Этап 2. Ищем слово "Итого" - нижняя правая граница диапазона. Этап 3 скопировать этот диапазон на другой лист - "Сводная"

С помощью макроса ниже могу найти позицию слова "Начало",
С помощью такого же отдельного макроса могу найти 2 слово, но как объединить найденые адресса этих ячеек в диапазон, пока не знаю

Внизу примерный макрос
Код
Sub Diapazon()

       For Each s In Range("A1:H100").Cells
       If s = "начало" Then
       'ActiveSheet.Cells(s.Row, s.Column).Select
       End If
   Next s
   
       For Each t In Range("A1:H100").Cells
       If s = "Итого" Then
       'ActiveSheet.Cells(s.Row, s.Column).Select
        End If
   Next t
   
      ActiveSheet.Range(Cells(t.Row, t.Column), Cells(s.Row, s.Column)).Copy

End Sub
Извлечение файлов и папок с указанных архивов с помощью VBA
 
Здравствуйте, с помощью указанного ниже кода, макрос ищет по указанному пути архивный файл и извлекает 3 определенных файла по маске в папку где находится этот архив. Но проблемма в том, что иногда в указанных архивах может быть еще один подархив или папка где имеются искомые файлы. Возможно ли подправить код, чтоб если не найдены файлы в архиве то открыл подархив (в этом же архиве если он имеется) или если нет то папку в этом архиве (если имеется)?
Код
Option Explicit
 
Sub Archives()
 
    On Error Resume Next
    Dim s7zipPath$, sArcPath$, sArcFile$, sDestPath$, sDelim$, CmdLine$
    Dim strDirPath$, strFileName$
    Dim strMaskSearch$
    Dim arr$(1), iPath$
    Dim x&, Numrows&, book As Workbook
    
    Application.ScreenUpdating = False 
    
    s7zipPath = "C:\Program Files\7-Zip\7z.exe" ' путь к архиватору 7zip
    
    Windows("Поиск файлов.xlsm").Activate
    Sheets("Limits").Select
    Numrows = Range("EE" & Rows.Count).End(xlUp).Row                              'диапазон ячеек с адресами 
    iPath = "D:\Companies\Statements\"                                            'корнева папка
     
    For x = 2 To Numrows
       
        Windows("Поиск файлов.xlsm").Activate
        Sheets("Limits").Select
        With Worksheets("Limits")
            arr(0) = .Cells(x, 135).Value                                               'адрес где искать архив, 1-ая часть адреса
            arr(1) = .Cells(x, 136).Value                                               'адрес где искать архив, 2-ая часть адреса
        End With
        strDirPath = iPath & arr(0) & "\" & arr(1) & "\"
        strMaskSearch = "*.zip*" And strMaskSearch = "*.rar*" And strMaskSearch = "*.7z*"   'возможные варианты архивов по указанному адресу
     
        sArcPath = strDirPath & strMaskSearch                                   ' путь к архиву
        sArcFile = "*#090*"                                                      ' имя 1 файла в архиве, который нужно распаковать (1)
        sArcaFile = "*#061*"                                                     ' имя 2 файла в архиве вариант 1, который нужно распаковать (2.1)
        sArccFile = "*#01S*"                                                     ' имя 2 файла в архиве вариант 2, который нужно распаковать (2.2)
        sArcbFile = "*#310*"                                                     ' имя 3 файла в архиве, который нужно распаковать (3)
        sDestPath = strDirPath                                                  ' путь к папке, куда распаковать файлы (полный или относительный)
    
        CmdLine = """" & s7zipPath & """" & " x " & """" & sArcPath & """" & " " & """" & sArcFile & """" & " -o" & """" & sDestPath & """" & " -y"  ' роспаковка(1)
        Shell CmdLine
        
        CmdLine = """" & s7zipPath & """" & " x " & """" & sArcPath & """" & " " & """" & sArcaFile & """" & " -o" & """" & sDestPath & """" & " -y" ' роспаковка(2.1)
        Shell CmdLine
    
        CmdLine = """" & s7zipPath & """" & " x " & """" & sArcPath & """" & " " & """" & sArccFile & """" & " -o" & """" & sDestPath & """" & " -y" ' роспаковка(2.2)
        Shell CmdLine
               
        CmdLine = """" & s7zipPath & """" & " x " & """" & sArcPath & """" & " " & """" & sArcbFile & """" & " -o" & """" & sDestPath & """" & " -y" 'роспаковка(3)
        Shell CmdLine
        
        'CreateObject("WScript.Shell").Run CmdLine, 1, True ' синхронный запуск
    
    Next

End Sub
Сохранения диапазонов книги по пути из списка папок и файлов
 
Цитата
Nordheim написал:
Как вариант перебор не по листу а по массиву.
Спасибо, попробую применить
Сохранения диапазонов книги по пути из списка папок и файлов
 
Спасибо вам большое вам за помощь, все получилось
Сохранения диапазонов книги по пути из списка папок и файлов
 
Выделяет строку 17 и сообщение "Compile error:
                                                        Expected function or variable"   выделяется именно слово OpenText
Сохранения диапазонов книги по пути из списка папок и файлов
 
Цитата
Nordheim написал:
Для чего вам столько мусора в коде?
Я столько раз уже менял всего, что уже начинаю забывать зачем и что нужно, удалю это. Спасибо
Сохранения диапазонов книги по пути из списка папок и файлов
 
Цитата
Nordheim написал:
У вас код в цикле делает одно и то же, для чего собственно цикл нужен?
Перебрать все названия клиентов из диапазона B2:B30 а название клиента должно вставлятся в адрес откуда берется файл
Сохранения диапазонов книги по пути из списка папок и файлов
 
Цитата
Anchoret написал:
Nameclient
вот здесь мне кажется нужно как то поменять, Nameclient должно браться из диапазона B2:B30 на листе "Письма". То есть первый раз название клиента ячейка B2, дальше выполнил макрос до Next и второй раз название клиента должно быть значение ячейки B3, потом В4  и т.д.
Сохранения диапазонов книги по пути из списка папок и файлов
 
Нет, не помогло, Nameclient всеравно принимает значение первой ячейки из диапазона  
Сохранения диапазонов книги по пути из списка папок и файлов
 
Спасибо, подправил по вашим советам, получилось как то так, но не знаю как теперь сделать цикл для открытия файлов по списку, когда выполняется макрос, доходит до next, возвращается к For но Folder принимает значение опять первой строки - A2, как "заставить" его опустится на 1 строку в диапазоне Numrows
Код
Sub Searches2222()
 
Dim strDirPath, strMaskSearch, strFileName, K As String
Dim Folder As String
Dim Namebank As String
Dim balancedate As String
Dim ibook As Workbook
Dim arr() As Workbook
Dim oRange As Range
Dim x As Integer         'numrows число строк данных

Numrows = Range("A2", Range("A2").End(xlDown)).Rows.Count ' диапазон

Range("A2").Select
For x = 1 To Numrows ' следующая строка в диапазоне

iPath = "D\Мои документы\"

Name = "Письма"
    Folder = Worksheets(Name).Cells(2, 1).Value 'адрес
    Nameclient = Worksheets(Name).Cells(2, 2).Value 'название
    K = Worksheets(Name).Cells(2, 3).Value 'дата
 
strDirPath = iPath & "\" & Folder & "\" & Nameclient & "\"
strMaskSearch = "*#02*" 'Маска поиска
  
'Получаем первый файл соответствующий шаблону
strFileName = Dir(strDirPath & strMaskSearch)
'---------------- Открытие файла *.* ----------------------------------
    Workbooks.OpenText FileName:=strDirPath & strFileName, Origin:=xlMSDOS _
        , StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array( _
        10, 1))
 
 
[A:J].Copy Workbooks("Анализ.xlsm").Sheets("Лист1").[C1]

Windows("Анализ.xlsm").Activate
Sheets("Limits").Select
ActiveCell.Offset(1, 0).Select
    Next
    
End Sub
Сохранения диапазонов книги по пути из списка папок и файлов
 
Подскажите, как правильно присвоить переменную в адрес файла?
Код
Sub Search()

Dim strDirPath, strMaskSearch, strFileName, a, d, K As String


Name = "Limits"
    a = Worksheets(Name).Cells(172, 6).Value 'адрес
    d = Worksheets(Name).Cells(173, 6).Value 'название
    K = Worksheets(Name).Cells(29, 4).Value 'дата 

strDirPath = "C:/Мои документы/a/d/" 'Папка поиска
strMaskSearch = "*02*" 'Маска поиска
 
'Получаем первый файл соответствующий шаблону
strFileName = Dir(strDirPath & strMaskSearch)
 
Do While strFileName <> "" 'До тех пор пока файлы "не закончатся"
    

'---------------- Открытие файла *.* ----------------------------------
    Workbooks.OpenText FileName:=strDirPath & strFileName, Origin:=xlMSDOS _
        , StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array( _
        10, 1))

    strFileName = Dir 'Следующий файл
Loop

Columns("A:J").Select
'    Selection.Cut
    
    Selection.Copy
    
    Windows("Riskovik_2.1.xlsm").Activate
    Sheets("Лист1").Select
    Range("C1").Select
    ActiveSheet.Paste
End Sub
 
Код
strDirPath = "C:/Мои документы/a/d/" 'Папка поиска 

в этой строке не видит а и d как название папки, а просто как букуву а и d  
Сохранения диапазонов книги по пути из списка папок и файлов
 
Я вручную открываю файл первого клиента: находится по адресу C:\Мои документы\ папка с названием A2 (название папки из диапазона A2:A30)\папка B2 (Название клиента из диапазона B2:B30). Название файла которые нужно открыть имеют все общую маску - "#02", я импортирую файл #02 из указанной папки в лист Excel, на листе провожу расчеты, после проведения расчетов сохраняю расчеты на 3 листах Excel в папку откуда взял файл #02 - C:\Мои документы\ A2 (диапазон A2:A30)\B2 (название из диапазона B2:B30), название файла B2&C2.xlsx, после этого перехожу к следующему клиенту по списку и так до конца списка. Если в списке 30 клиентов, значит есть 30 папок и вкаждой папке по одному файлу #02

Использую такой макрос для импортирования файла, но мне нужно что б папку и файл макрос выбрал сам, провел расчеты, сохранил 3 листа Excel в ту же папку откуда взял файл #02 и автоматически перешел к следующему клиенту
Код
Sub FileOpen()
Application.ScreenUpdating = True
fileToOpen = Application _
    .GetOpenFilename("Все файлы (*.*), *.*", , "*** Ввод файла ***")
Application.ScreenUpdating = False
If fileToOpen <> False Then
'---------------- Открытие файла *.* ----------------------------------
    Workbooks.OpenText Filename:=fileToOpen, Origin:=xlMSDOS _
        , StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array( _
        10, 1))
End If

   Columns("A:J").Select
'    Selection.Cut
    
    Selection.Copy
    
    Windows("Копирование по списку").Activate
    Sheets("Лист1").Select
    Range("C1").Select
    ActiveSheet.Paste

Макрос открывает в Excel файл и копирует данные с файла на Лист 1, на других 3 листах проводятся расчеты, и эти 3 листа сохраняются в соответствующую папку
Изменено: Dodger-j - 26.02.2018 21:09:26
Сохранения диапазонов книги по пути из списка папок и файлов
 
Хорошо, но как в цикле открыть файлы txt из этих папок, согласно того же списка ни листе?
Сохранения диапазонов книги по пути из списка папок и файлов
 
Макрос создает папки, но они уже созданы до этого, и в этих папках лежат файлы txt, которые надо открыть, обработать и в ту же папку сохранить excel файл
Изменено: Dodger-j - 26.02.2018 17:35:21
Сохранения диапазонов книги по пути из списка папок и файлов
 
По указанному адресу, например: D:\Docs\Клиент 1\Иванов  лежит файл #000011 (в вложении)
                                                         D:\Docs\Клиент 2\Петров  лежит такого же типа файл, (как в вложении)
                                                         D:\Docs\Клиент 3\Петренко  лежит такого же типа файл, (как в вложении) и так дальше, по списку в диапазоне A1:C31,
Я вручную открываю файл по каждому клиенту, с помощью формул собираю данные, с помощью исправленного выше макроса сохраняю книгу по в ту же самую папку по адресу D:\Docs\Клиент 1\Иванов с названием Иванов_01.02.2018 (это для первого клиента).
Я же пытаюсь сделать цикл, чтоб макрос самостоятельно по указанному списку в A1:C31 открыл файл 1 клиента по адресу - D:\Docs\Клиент 1\Иванов, скопировал необходимые данные, сохранил в указанной в диапазоне  A1:C31 папке 3 листа из книги (макрос сохранения уже подправлен), и перешел к следующему клиенту по списку - Петров и сделал все тоже самое: открыл, скопировал, сохранил. Сам список клиентов каждые день меняется, сегодня 5 клиентов, завтра 30 и т.д., по этому списку я создаю папки - отдельную для каждого клиента, а клиенты в соответствующую папку кладут каждый свой файл

Надеюсь теперь понятнее

Макрос открытия файла ниже:
Код
Sub Макрос2()
Application.ScreenUpdating = True
fileToOpen = Application _
    .GetOpenFilename("Все файлы (*.*), *.*", , "*** Ввод файла ***")
Application.ScreenUpdating = False
If fileToOpen <> False Then
'---------------- Открытие файла *.* ----------------------------------
    Workbooks.OpenText Filename:=fileToOpen, Origin:=xlMSDOS _
        , StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array( _
        10, 1))
    
End If

   Columns("A:J").Select
'    Selection.Cut
    
    Selection.Copy
    
    Windows("Копирование по списку").Activate
    Sheets("Лист1").Select
    Range("C1").Select
    ActiveSheet.Paste


End Sub
Изменено: Dodger-j - 26.02.2018 16:44:32
Сохранения диапазонов книги по пути из списка папок и файлов
 
Фух, получилось, простите меня новичка, но как теперь цикл сделать?
Изменено: Dodger-j - 26.02.2018 16:05:47
Сохранения диапазонов книги по пути из списка папок и файлов
 
Я так и сделал, подумал может еще что то дописать надо,

Теперь сообщение "К сожалению нам не удалось найти файл C:\Docs\Клиент 1\Иванов\Иванов_01.02.2018.xlsx. Возможно он был перемещен, переименован или удален?" но почему в этом коде ищентся файл, в строке которая ниже. я его только создаю файл по адресу
Код
ActiveWorkbook.SaveCopyAs Filename:="С:\Мои документы\" & a & "\" & d & "\" & d & "_" & k & ".xlsx"
Сохранения диапазонов книги по пути из списка папок и файлов
 
Цитата
Nordheim написал:
в этом случае поймете где ошибка.
"Не удалось найти файл по указанному адресу, возможно он был удален или перемещен", как такое возможно, вы меня извините, я не продвинутый пользователь, недавно начал изучение, как именно нужно закомментировать?
Сохранения диапазонов книги по пути из списка папок и файлов
 
Цитата
Nordheim написал:
Отключите обработку ошибок и прогоните свой макрос с помощью F8
Сделал как вы говорите, выяснил, что не присваивается значение ячейки для a, d, k. А если вернуть шаг обратно на строку присваивания значения, то выдает значение ячейки, ничего теперь не понимаю, нарисовалась еще одна проблемма(
Сохранения диапазонов книги по пути из списка папок и файлов
 
Сделал как вы говорите, но ничего не понимаю, почему то не прописывается значение ячейки для a, d и k, теперь оказывается еще одна проблемма

Цитата
Nordheim написал: А тут ошибку не выдает?
Нет, не выдает. В принцыпе можно написать в кавычках двойных, но у меня работает, только что проверил
Код
Range("A1").Select
Изменено: Dodger-j - 26.02.2018 14:59:56
Сохранения диапазонов книги по пути из списка папок и файлов
 
Цитата
Nordheim написал:
из 1 сообщения работает
Не сработал, понял в чем дело Неправильно прописал выбор листа, скопировал не тот вариант кода

Вместо этого
Код
    Worksheets Данные.Select    
    Range(K5, Q15).Select
    Selection.Copy
    Worksheets Письма.Select
    Range(A1).Select

Надо сделать вот так
   
Код
    Sheets("Данные").Select
    Range("K5:Q15").Select
    Selection.Copy
    Sheets("Письма").Select
    Range(A1).Select
Изменено: Dodger-j - 26.02.2018 14:38:01
Сохранения диапазонов книги по пути из списка папок и файлов
 
Цитата
Nordheim написал:
Что делает этот макрос?
Этот макрос открывает и импортирует txt файл в книгу в определенный лист, на листе по данным из импортируемого файла производятся рассчеты, один файл - 1 клиент, по каждому клиенту есть файл
Код
Sub Макрос 2()
Application.ScreenUpdating = True
fileToOpen = Application _
    .GetOpenFilename("Все файлы (*.*), *.*", , "*** Ввод файла ***")
Application.ScreenUpdating = False
If fileToOpen <> False Then
'---------------- Открытие файла *.* ----------------------------------
    Workbooks.OpenText Filename:=fileToOpen, Origin:=xlMSDOS _
        , StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array( _
        10, 1))
    Else: IndOpen = 0
    
    If IndOpen = 1 Then GoTo Finita

    Columns("A:J").Select
'    Selection.Cut
    
    Selection.Copy
    
    Windows("Данные.xlsm").Activate
    Sheets("Лист1").Select
    Range("C1").Select
    ActiveSheet.Paste

Finita:
Application.ScreenUpdating = True
Sheets("Данные").Select

End If
Изменено: Dodger-j - 26.02.2018 14:23:43
Страницы: 1 2 След.
Наверх