Страницы: 1 2 След.
RSS
вставить найденный диапазон справа через шесть столбцов, макрос
 
здравствуйте. в файле "123" есть макрос, который раньше давал результат как на листе "как было раньше". сейчас результат другой. причем, с макросом ничего не делал. разве что переустанавливал Excel. пробовал менять цифры, но не угадал. не могли бы посмотреть и поправить что нужно
 
Column + 12
 
RAN, работает! спасибо. только раньше первый диапазон вставлялся в А1. наверное так тоже подойдет
 
проверил везде этот макрос - в каждом только +7. хотел бы понять почему сейчас надо изменить. не могли бы сказать какой кнопкой макрос пошагово запускать. и если не трудно раскомментируйте шаги макроса
Код
Dim a As Long
Dim b As Long
For b = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If CStr(Cells(b, 1)) Like "DATE" Then
        For a = b + 1 To Cells(Rows.Count, 1).End(xlUp).Row + 1
            If CStr(Cells(a, 1)) Like "DATE" Or CStr(Cells(a, 1)) Like "" Then
                Range(Cells(b, 1), Cells(a - 1, 6)).Cut
                Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column + 7).Select
                ActiveSheet.Paste
                b = a
            End If
        Next a
    End If
Next b
после обработки открыл отдельно файл 500КК1. там первый диапазон начинается в ячейке A1. а во время работы макроса копируемый диапазон заполнен начиная с ячейки M1. что нужно добавить чтобы и при копировании диапазона заполнялось с ячейки А1?
Изменено: artyrH - 19.05.2019 10:56:24
 
Цитата
artyrH написал: не могли бы посмотреть и поправить что нужно
Проще новый написать  ;)
Код
Sub DDDD200()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Worksheets("данные").Cells.Clear
Dim iWb As Workbook, cl As Range, iAdrs$, iOf&, lClmn&, arr()
Set iWb = Workbooks.Open(Filename:="C:\test\" & Worksheets("Лист6").Range("K15").Value)
With iWb.Worksheets(1)
    lClmn = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set cl = .Rows(1).Find("DATE", After:=.Cells(1, lClmn))
    If Not cl Is Nothing Then
        iAdrs = cl.Address
        Do
            arr = cl.Offset(1).Resize(.Cells(.Rows.Count, cl.Column).End(xlUp).Row, 6).Value
            ThisWorkbook.Worksheets("данные").Range("A2").Offset(, iOf).Resize(UBound(arr), UBound(arr, 2)) = arr
            iOf = iOf + 12
            Erase arr
            Set cl = .Rows(1).FindNext(cl)
        Loop While Not cl Is Nothing And cl.Address <> iAdrs
    End If
End With
iWb.Close False
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Изменено: Sanja - 19.05.2019 12:03:42
Согласие есть продукт при полном непротивлении сторон
 
Цитата
artyrH написал: только раньше первый диапазон вставлялся в А1
Уверены? На листе 'как было раньше' данные заполнены с ячейки A2
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
Уверены?
опечатался), с А2. в первом столбце были данные
 
Цитата
Sanja написал:
Проще новый написать
спасибо, только ничего не меняется. то есть ничего не происходит. на листе данные нет никаких значений
 
Цитата
artyrH написал: спасибо
Пожалуйста. Я Вам могу записать виде о том, что 'все происходит', на лист 'данные' значения копируются.
Вы запускали макрос в Вашем (нашем) файле-примере? Добавил на лист кнопку запуска макроса, для наглядности
Изменено: Sanja - 19.05.2019 12:04:41
Согласие есть продукт при полном непротивлении сторон
 
Sanja, извиняюсь что не отвечал - был занят. давайте все таки попробуем сделать Ваш макрос работающим. на гиф видно что пытается открыть файл, но не открыл
 
при использовании кода в таком виде как на скрине файл 500КК1 как оказалось открылся, но не обработался и почему то даже не скопировался и в таком виде  
Изменено: artyrH - 19.05.2019 14:32:05
 
Цитата
artyrH написал: опечатался), с А2. в первом столбце были данные
Вы видимо опять опечатались.
В файле '500KK1', который Вы приложили в качестве примера, данные начинаются с ПЕРВОЙ строки (слова 'DATE' в первой строке), а в реальных данных, судя по скрину, во ВТОРОЙ
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
видимо опять опечатались
запутался. изначально было DATE в А2. потом уже пробовал и с DATE в А1. все это вчера полночи и сегодня утром. но и с этим вариантом Ваш макрос не работает. просто скопировал весь диапазон в книгу 123. только без первой строки с DATE
 
Цитата
artyrH написал: ..но и с этим вариантом Ваш макрос не работает..
А я утверждаю что работает. С тем файлом, который Вы приложили в архиве. И по тому пути к нему, который указан в коде.
Согласие есть продукт при полном непротивлении сторон
 
Sanja, позже отвечу  
 
Цитата
RAN написал:
Column + 12
в файле макрос из шапки с +12 обрабатывает только 500KK1, а файл 500KK8 не обрабатывает. почему?
Sanja, спасибо. скачал свой .rar и увидел что макрос обработал 500KK1 спокойно. но у меня все файлы как 500KK8. почему их не обрабатывает макрос? мне бы Ваш макрос под 500KK8 подшаманить
без разницы DATE в А1 или в А2
отвечать смогу с перерывами
Изменено: artyrH - 19.05.2019 17:34:49
 
И с файлом 500KK8 отработал без проблем. Вы название этого файла в ячейку "K15' листа 'Лист6' вставляете?
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
вставляете?
ну а как же
получается что обработка идет, но не так как надо. на скрине отметил
 
Цитата
artyrH написал:
в файле макрос из шапки с +12 обрабатывает только 500KK1, а файл 500KK8 не обрабатывает. почему?
Без понятия. Я убрал все лишнее, открыл файл, поглядел, дал ответ.
Все остальное <> "6 столбцов"
нужно начинать с "как надо", а не заканчивать
Цитата
artyrH написал:
но не так как надо.
Изменено: RAN - 19.05.2019 18:14:22
 
Так таковы исходные данные в файле 500KK8. Или я чего то не понимаю....
Согласие есть продукт при полном непротивлении сторон
 
Цитата
artyrH написал:
а файл 500KK8 не обрабатывает
не может быть такого что этот файл открывает как, я не знаю, текстовый и макросу обработать в другие столбцы не получается?
 
В исходном файле данные это Даты или числовые значения?
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
таковы исходные данные
ничего себе. извиняюсь. я уже в другом макросе менял чтоб DATE  было в А1. щас за полчаса проверю все и сделаю DATE d A2
 
Цитата
Sanja написал:
Даты или числовые значения?
даты только в первой колонке
вот файл только с DATE со второй строки. по другому косяки выходят  
 
artyrH, Вы издеваетесь!? В исходном файле, который был приложен в архиве (500KK1) данные расположены в СТРОКУ, а в том, который Вы пытаетесь обработать моим макросом данные расположены в СТОЛБЕЦ!!! Вы совсем разницы не видите!?
Изменено: Sanja - 19.05.2019 19:03:02
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
Вы издеваетесь!? .. Вы совсем разницы не видите!?
не  пойму о чем вы. скачал шапку, сделал скрины. я не вижу разницы. одинаково же?
 
Цитата
artyrH написал: не  пойму о чем вы
Вот скрин и сам файл, который Вы приложили в качестве примера в архиве, в стартовом сообщении. Вы думаете я сам его к такому виду привел!?
Согласие есть продукт при полном непротивлении сторон
 
Цитата
Sanja написал:
думаете я сам его к такому виду привел
:)  давайте Вы еще раз скачаете шапку. по моему там по другому построено
наверное, после применения Вами макросов из шапки этот файл изменился  
 
Цитата
artyrH написал: давайте Вы еще раз скачаете шапку
Скачал. Файл в архиве заменен на другой.
Макрос написан для совсем другого расположения исходных данных
Разве не Вы писали ранее
Цитата
artyrH написал: Sanja , спасибо. скачал свой .rar и увидел что макрос обработал 500KK1 спокойно
Согласие есть продукт при полном непротивлении сторон
 
Sanja, в принципе, вот этот макрос делает что нужно. только мне кажется Ваш макрос побыстрее
Код
Sub DDDD200()
    Application.Calculation = xlCalculationManual
    'Отключаем отслеживание событий
    Application.EnableEvents = False
    'Отключаем разбиение на печатные страницы
    Application.DisplayStatusBar = False
  
    Sheets("данные").Range("A1:XET350").Clear
    
    
    Workbooks.Open Filename:="C:\test\" & Worksheets("Лист6").Range("K15").Value
Dim a As Long
Dim b As Long
For b = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    If CStr(Cells(b, 1)) Like "DATE" Then
        For a = b + 1 To Cells(Rows.Count, 1).End(xlUp).Row + 1
            If CStr(Cells(a, 1)) Like "DATE" Or CStr(Cells(a, 1)) Like "" Then
                Range(Cells(b, 1), Cells(a - 1, 6)).Cut
                Cells(1, Cells(1, Columns.Count).End(xlToLeft).Column + 12).Select
                ActiveSheet.Paste
                b = a
            End If
        Next a
    End If
Next b
    Range("A2:CNO350").Select
    Selection.Copy
    Windows("123.xlsm").Activate
    Sheets("данные").Select
    Range("A2").Select
    ActiveSheet.Paste
    

    
    Application.CutCopyMode = False
        Workbooks(Worksheets("Лист6").Range("K15").Value).Activate
    ActiveWorkbook.Close True
      
     Sheets("данные").Select
      Range("M2:COV350").Copy Range("A2")

    Application.Calculation = xlCalculationAutomatic
    'Включаем отслеживание событий
    Application.EnableEvents = True
End Sub
Страницы: 1 2 След.
Наверх