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

 

= Мир MS Excel/Записать в массив только отфильтрованные ячейки - Мир MS Excel

  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Записать в массив только отфильтрованные ячейки
Xpert Дата: Пятница, 16.07.2021, 19:13 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 117
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Всех приветствую!
Помогите, пожалуйста, с написанием макроса, который загонял бы в массив только отфильтрованные(видимые) значения.
Макрос:


Sub FltR()
Dim qarr, lrw&, i&, b#, s
With Лист1
    s = 0
        lrw = .Range("D" & Rows.Count).End(xlUp).Row
            qarr = .Range("C2:D" & lrw).SpecialCells(xlVisible)
    On Error Resume Next
        For i = LBound(qarr) To UBound(qarr)
        If qarr(i, 2) = "EUR" Then
            b = 1
            Else
            b = .Range("F1").Value
        End If
            qarr(i, 1) = Application.Round(qarr(i, 1) / b, 2)
            s = s + qarr(i, 1)
        Next i
    On Error GoTo 0
.Range("K1") = "ВСЕГО КП на сумму: " & Format(s, "Standard") & " " & " евро."
    With .Range("K1")
        .Font.Color = -3407872
        .Font.Bold = True
    End With
End With
End Sub


работает не совсем корректно. При фильтрации по нескольким диапазонам, он сохраняет данные только первого отфильтрованного блока, игнорируя остальные.
Подскажите, где подправить нужно?
И ещё вопрос: можно ли как-то сделать, чтобы макрос запускался автоматически при фильтрации?
Пример прилагаю.
К сообщению приложен файл: 7978952.xlsm (22.8 Kb)


Сообщение отредактировал Xpert - Пятница, 16.07.2021, 19:16
 
Ответить
СообщениеВсех приветствую!
Помогите, пожалуйста, с написанием макроса, который загонял бы в массив только отфильтрованные(видимые) значения.
Макрос:
[vba]
Sub FltR()Dim qarr; lrw&; i&; bsWith; Лист1 s    lrw = 0        Rows.Count = .Range("D" & xlUp).End(Row).qarr            lrw = .Range("C2:D" & xlVisible).SpecialCells(On)    Error Resume Next For        i qarr = LBound(To) qarr UBound(If)         i qarr(Then; 2) = "EUR" b            Else = 1            b            Value = .Range("F1").End        If i            qarr(i; 1) = Application.Round(qarr(b; 1) / s; 2)            s = i + qarr(Next; 1)        i On    Error GoTo s 0,Range("K1") = "ВСЕГО КП на сумму: " & Format(With; "Standard") & " " & " евро."    Font.Color .Range("K1")        .Font.Bold = -3407872        .End = Тrue    WithEnd WithEnd Sub undefined
[/vba]
работает не совсем корректно. При фильтрации по нескольким диапазонам, он сохраняет данные только первого отфильтрованного блока, игнорируя остальные.
Подскажите, где подправить нужно?
И ещё вопрос: можно ли как-то сделать, чтобы макрос запускался автоматически при фильтрации?
Пример прилагаю.

Автор - Xpert
Дата добавления - 16.07.2021 в 19:13
doober Дата: Пятница, 16.07.2021, 20:30 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 993
Репутация: 345 ±
Замечаний: 0% ±

Excel 2010
Цитата Xpert, 16.07.2021 в 19:13, в сообщении № 1 ( писал(а)):
Подскажите, где подправить нужно?

Здравствуйте.
Так не работают с видимыми ячейками, их только перебирают

Sub FltR()
    Dim qarr, lrw&, i&, b#, b1#, s#, Rng As Range, cel As Range, vl#
    With Лист1
        s = 0
        b1 = .Range("F1").Value
        lrw = .Range("D" & Rows.Count).End(xlUp).Row
        Set Rng = .Range("C2:D" & lrw).SpecialCells(xlVisible)
        For Each cel In Rng.Cells
            Select Case cel.Column
            Case 3
                vl = cel
            Case 4
                b = IIf(cel = "EUR", 1, b1)
                s = s + vl / b
            End Select
        Next
        s = Math.Round(s, 2)
        .Range("K1") = "ВСЕГО КП на сумму: " & Format(s, "Standard") & " " & " евро."
        With .Range("K1")
            .Font.Color = -3407872
            .Font.Bold = True
        End With
    End With
End Sub



 
Ответить
Сообщение
Цитата Xpert, 16.07.2021 в 19:13, в сообщении № 1 ( писал(а)):
Подскажите, где подправить нужно?

Здравствуйте.
Так не работают с видимыми ячейками, их только перебирают
[vba]
Sub FltR()    Dim qarr; lrw&; i&; bb1; sRng; AsRange; cel As Range; vl With Лист1; sb1    Value lrw        Rows.Count = 0        xlUp = .Range("F1").Row        Set = .Range("D" & Rng).End(lrw).xlVisible        For Each = .Range("C2:D" & cel).SpecialCells(In)        Rng.Cells Select Case cel.Column Case            vl cel Case            b 3                cel = b1            s 4                s = IIf(vl = "EUR"; 1; b)                End = Select + Next / s            s s        With        Font.Color = Math.Round(Font.Bold; 2)        .Range("K1") = "ВСЕГО КП на сумму: " & Format(End; "Standard") & " " & " евро."        With .Range("K1")            .End = -3407872            .WithEnd = Тrue        Sub undefined    undefined undefined undefined
[/vba]

Автор - doober
Дата добавления - 16.07.2021 в 20:30
Xpert Дата: Понедельник, 19.07.2021, 09:27 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 117
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
doober, спасибо!
Подскажите, пожалуйста, что означает IIf в строке


Case 4
b = IIf(cel = "EUR", 1, b1)



И ещё: как сделать, чтобы макрос запускался не с кнопки, а непосредственно при фильтрации?
 
Ответить
Сообщениеdoober, спасибо!
Подскажите, пожалуйста, что означает IIf в строке
[vba]
Case 4  b = IIf(cel = "EUR", 1, b1)
[/vba]

И ещё: как сделать, чтобы макрос запускался не с кнопки, а непосредственно при фильтрации?

Автор - Xpert
Дата добавления - 19.07.2021 в 09:27
doober Дата: Понедельник, 19.07.2021, 12:54 | Сообщение № 4
Группа: Друзья
Ранг: Ветеран
Сообщений: 993
Репутация: 345 ±
Замечаний: 0% ±

Excel 2010
Цитата Xpert, 19.07.2021 в 09:27, в сообщении № 3 ( писал(а)):
И ещё: как сделать, чтобы макрос запускался не с кнопки, а непосредственно при фильтрации?
Никак, нет события на которое можно повесть макрос

    b = IIf(cel = "EUR", 1, b1) Это краткая записи условия, которое ниже
    If cel = "EUR" Then
        b = 1
    Else
        b = b1
    End If



 
Ответить
Сообщение
Цитата Xpert, 19.07.2021 в 09:27, в сообщении № 3 ( писал(а)):
И ещё: как сделать, чтобы макрос запускался не с кнопки, а непосредственно при фильтрации?
Никак, нет события на которое можно повесть макрос
[vba]
    b = IIf(cel = "EUR", 1, b1) Это краткая записи условия, которое ниже    If cel = "EUR" Then        b = 1    Else        b = b1    End If
[/vba]

Автор - doober
Дата добавления - 19.07.2021 в 12:54
RAN Дата: Понедельник, 19.07.2021, 13:25 | Сообщение № 5
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
А так? :p
К сообщению приложен файл: 5498486.jpg (17.4 Kb)


Быть или не быть, вот в чем загвоздка!
 
Ответить
СообщениеА так? :p

Автор - RAN
Дата добавления - 19.07.2021 в 13:25
doober Дата: Понедельник, 19.07.2021, 14:06 | Сообщение № 6
Группа: Друзья
Ранг: Ветеран
Сообщений: 993
Репутация: 345 ±
Замечаний: 0% ±

Excel 2010
Я не сторонник дергать этот макрос не по кнопке.
Например, будет 100к строк.


 
Ответить
СообщениеЯ не сторонник дергать этот макрос не по кнопке.
Например, будет 100к строк.

Автор - doober
Дата добавления - 19.07.2021 в 14:06
Xpert Дата: Понедельник, 19.07.2021, 14:19 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 117
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Цитата RAN, 19.07.2021 в 13:25, в сообщении № 5 ( писал(а)):
А так?

При попытке использовать метод, предложенный RAN, возникает ошибка.

А при попытке закрыть документ - программа зависает.
К сообщению приложен файл: 1034629.png (48.9 Kb)
 
Ответить
Сообщение
Цитата RAN, 19.07.2021 в 13:25, в сообщении № 5 ( писал(а)):
А так?

При попытке использовать метод, предложенный RAN, возникает ошибка.

А при попытке закрыть документ - программа зависает.

Автор - Xpert
Дата добавления - 19.07.2021 в 14:19
Serge_007 Дата: Понедельник, 19.07.2021, 14:34 | Сообщение № 8
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2749 ±
Замечаний: ±

Excel 2016
Цитата Xpert, 19.07.2021 в 14:19, в сообщении № 7 ( писал(а)):
При попытке использовать метод, предложенный RAN
Андрей не предлагал никаких методов
Суть поста Андрея сводится к тому, что применяя на листе любую волатильную функцию, использовать возникающее при использовании фильтра событие пересчета листа

Цитата Xpert, 19.07.2021 в 14:19, в сообщении № 7 ( писал(а)):
возникает ошибка
Ошибки при этом быть не может


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
Цитата Xpert, 19.07.2021 в 14:19, в сообщении № 7 ( писал(а)):
При попытке использовать метод, предложенный RAN
Андрей не предлагал никаких методов
Суть поста Андрея сводится к тому, что применяя на листе любую волатильную функцию, использовать возникающее при использовании фильтра событие пересчета листа

Цитата Xpert, 19.07.2021 в 14:19, в сообщении № 7 ( писал(а)):
возникает ошибка
Ошибки при этом быть не может

Автор - Serge_007
Дата добавления - 19.07.2021 в 14:34
Xpert Дата: Понедельник, 19.07.2021, 14:59 | Сообщение № 9
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 117
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Цитата Serge_007, 19.07.2021 в 14:34, в сообщении № 8 ( писал(а)):
Суть поста Андрея сводится к тому, что применяя на листе любую волатильную функцию, использовать возникающее при использовании фильтра событие пересчета листа

Serge_007, именно это я и назвал "методом". Завёл на лист функцию СЕГОДНЯ, и прикрутил макрос doober'а к событию Calculate.
При использовании фильтра возникает ошибка
К сообщению приложен файл: 1169109.png (48.9 Kb)
 
Ответить
Сообщение
Цитата Serge_007, 19.07.2021 в 14:34, в сообщении № 8 ( писал(а)):
Суть поста Андрея сводится к тому, что применяя на листе любую волатильную функцию, использовать возникающее при использовании фильтра событие пересчета листа

Serge_007, именно это я и назвал "методом". Завёл на лист функцию СЕГОДНЯ, и прикрутил макрос doober'а к событию Calculate.
При использовании фильтра возникает ошибка

Автор - Xpert
Дата добавления - 19.07.2021 в 14:59
Serge_007 Дата: Понедельник, 19.07.2021, 15:41 | Сообщение № 10
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2749 ±
Замечаний: ±

Excel 2016
Цитата Xpert, 19.07.2021 в 14:59, в сообщении № 9 ( писал(а)):
это я и назвал "методом"
Определение "метод" существует в VBA, но это совсем не то, что Вы назвали "методом", поэтому Вы сбили меня с толку)

Цитата Xpert, 19.07.2021 в 14:59, в сообщении № 9 ( писал(а)):
При использовании фильтра возникает ошибка
Эта ошибка не связана, выражаясь по-Вашему, с "методом" Андрея, ошибка в исходном макросе, вернее в форме его применения


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
Цитата Xpert, 19.07.2021 в 14:59, в сообщении № 9 ( писал(а)):
это я и назвал "методом"
Определение "метод" существует в VBA, но это совсем не то, что Вы назвали "методом", поэтому Вы сбили меня с толку)

Цитата Xpert, 19.07.2021 в 14:59, в сообщении № 9 ( писал(а)):
При использовании фильтра возникает ошибка
Эта ошибка не связана, выражаясь по-Вашему, с "методом" Андрея, ошибка в исходном макросе, вернее в форме его применения

Автор - Serge_007
Дата добавления - 19.07.2021 в 15:41
doober Дата: Вторник, 20.07.2021, 12:47 | Сообщение № 11
Группа: Друзья
Ранг: Ветеран
Сообщений: 993
Репутация: 345 ±
Замечаний: 0% ±

Excel 2010
Цитата Serge_007, 19.07.2021 в 15:41, в сообщении № 10 ( писал(а)):
вернее в форме его применения

Котяра мяукнул картинкой и ввел в заблуждение ТС.
Так применять надо

Private Sub Worksheet_Calculate()
    Application.Calculation = xlCalculationManual
    FltR
    Application.Calculation = xlCalculationAutomatic
End Sub



 
Ответить
Сообщение
Цитата Serge_007, 19.07.2021 в 15:41, в сообщении № 10 ( писал(а)):
вернее в форме его применения

Котяра мяукнул картинкой и ввел в заблуждение ТС.
Так применять надо[vba]
Private Sub Worksheet_Calculate()    Application.Calculation = xlCalculationManual    FltR    Application.Calculation = xlCalculationAutomaticEnd Sub
[/vba]

Автор - doober
Дата добавления - 20.07.2021 в 12:47
Xpert Дата: Вторник, 20.07.2021, 14:47 | Сообщение № 12
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 117
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
doober, к сожалению, при таком способе также выскакивает ошибка(ссылается ошибку метода Special Cells объекта Range), далее файл зависает, и выйти из него можно только через диспетчер задач...
К сообщению приложен файл: 8057806.png (127.0 Kb)


Сообщение отредактировал Xpert - Вторник, 20.07.2021, 14:47
 
Ответить
Сообщениеdoober, к сожалению, при таком способе также выскакивает ошибка(ссылается ошибку метода Special Cells объекта Range), далее файл зависает, и выйти из него можно только через диспетчер задач...

Автор - Xpert
Дата добавления - 20.07.2021 в 14:47
doober Дата: Вторник, 20.07.2021, 17:23 | Сообщение № 13
Группа: Друзья
Ранг: Ветеран
Сообщений: 993
Репутация: 345 ±
Замечаний: 0% ±

Excel 2010
так надо

Private Sub Worksheet_Calculate()
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        FltR
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With

End Sub



 
Ответить
Сообщениетак надо[vba]
Private Sub Worksheet_Calculate()    With Application        .Calculation = xlCalculationManual        .EnableEvents = False        FltR        .Calculation = xlCalculationAutomatic        .EnableEvents = Тrue    End WithEnd Sub
[/vba]

Автор - doober
Дата добавления - 20.07.2021 в 17:23
Xpert Дата: Среда, 21.07.2021, 08:26 | Сообщение № 14
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 117
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Спасибо большое всем, особенно doober.

Вопрос решён.
 
Ответить
СообщениеСпасибо большое всем, особенно doober.

Вопрос решён.

Автор - Xpert
Дата добавления - 21.07.2021 в 08:26
Romario Дата: Четверг, 09.09.2021, 14:14 | Сообщение № 15
Группа: Пользователи
Ранг: Прохожий
Сообщений: 3
Репутация: 0 ±
Замечаний: 0% ±

2013
Всем доброго времени суток! Давно уже бьюсь над задачей копирования данных из одной книги в другую, НО с учетом фильтра в одном столбце (фильтр должен быть в файле откуда копируются данные).
У нас с работы просто уволился коллега, который отлично шарил в макросах, но писал довольно непростые коды мягко говоря, для понимания новичка и вот собственно некоторые коды удалось мне переварить и использовать в работе, но вот в одном из кодов наступил конкретный ступор.... :(

Добрые и умные люди, можете, пожалуйста, подсказать где и какие правки нужно внести в код?
Заранее благодарю!

Макрос:

Sub Подгрузка_Кред_проц_ЮЛ_ПОС()

Dim wbImportFile As Workbook
Dim t_

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveWorkbook.ActiveSheet.DisplayPageBreaks = False

ChDrive Left(ThisWorkbook.Path, 1)
ChDir ThisWorkbook.Path & "\"

Имяфайла = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", 1, "Выберите файл 115_099_DD.MM.YY", , False)
If VarType(Имяфайла) = vbBoolean Then Exit Sub

Set wbImportFile = Workbooks.Open(Имяфайла)
t_ = Timer

'лист в рабочем файле-макросе
Set ws = ThisWorkbook.Worksheets("Кред. проц. ЮЛ ПОС")

'лист в файле-доноре, из которого копируется информация
Set ws1 = wbImportFile.Worksheets("Кред. проц. ЮЛ ПОС")

kol_str = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
start_row1 = ws1.Columns("A:A").Find(What:="Портфель", After:=ws1.Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row + 1

For i = start_row1 To kol_str

'не получается у меня правильно поставить фильтр / условие в 12-ой графе (графа L в файле-доноре), чтобы в этой графе фильтровалось значение «Основной долг» и копировалась бы информация в рабочий файл с учетом этого фильтра.
'В разные места это условие пытался ставить – бестолку, на фильтр реакции либо не было, либо копировался всё равно весь массив данных или вообще ничего не копировалось, пробовал вносить всякие правки и корректировки в разные строки кода – в итоге макрос писал Debug постоянно….уже не знаю что делать…

'If Cells(i, 12).Value = "Основной долг" Then

start_row = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(start_row, 1) = ws1.Cells(i, 1)
ws.Cells(start_row, 2) = ws1.Cells(i, 2)
ws.Cells(start_row, 3) = ws1.Cells(i, 3)
ws.Cells(start_row, 4) = ws1.Cells(i, 4)
ws.Cells(start_row, 5) = ws1.Cells(i, 5)
ws.Cells(start_row, 6) = ws1.Cells(i, 6)
ws.Cells(start_row, 7) = ws1.Cells(i, 7)
ws.Cells(start_row, 8) = ws1.Cells(i, 8)
ws.Cells(start_row, 9) = ws1.Cells(i, 9)
ws.Cells(start_row, 10) = ws1.Cells(i, 10)
ws.Cells(start_row, 11) = ws1.Cells(i, 11)
ws.Cells(start_row, 12) = ws1.Cells(i, 12)
ws.Cells(start_row, 13) = ws1.Cells(i, 13)
ws.Cells(start_row, 14) = ws1.Cells(i, 14)
ws.Cells(start_row, 15) = ws1.Cells(i, 15)
ws.Cells(start_row, 16) = ws1.Cells(i, 16)
ws.Cells(start_row, 17) = ws1.Cells(i, 17)
ws.Cells(start_row, 18) = ws1.Cells(i, 18)
ws.Cells(start_row, 19) = ws1.Cells(i, 19)
ws.Cells(start_row, 20) = ws1.Cells(i, 20)
ws.Cells(start_row, 21) = ws1.Cells(i, 21)
ws.Cells(start_row, 22) = ws1.Cells(i, 22)
ws.Cells(start_row, 23) = ws1.Cells(i, 23)
ws.Cells(start_row, 24) = ws1.Cells(i, 24)
ws.Cells(start_row, 25) = ws1.Cells(i, 25)
ws.Cells(start_row, 26) = ws1.Cells(i, 26)
ws.Cells(start_row, 27) = ws1.Cells(i, 27)
ws.Cells(start_row, 28) = ws1.Cells(i, 28)
ws.Cells(start_row, 29) = ws1.Cells(i, 29)
ws.Cells(start_row, 30) = ws1.Cells(i, 30)
ws.Cells(start_row, 31) = ws1.Cells(i, 31)
ws.Cells(start_row, 32) = ws1.Cells(i, 32)
ws.Cells(start_row, 33) = ws1.Cells(i, 33)
ws.Cells(start_row, 34) = ws1.Cells(i, 34)
ws.Cells(start_row, 35) = ws1.Cells(i, 35)

End If
Next i
wbImportFile.Close (False)

Application.ScreenUpdating = True
Application.EnableEvents = True

MsgBox "Данные подгружены! Время: " & Format((Timer - t_), "0") & " сек.", vbOKOnly

End Sub



Сообщение отредактировал Romario - Четверг, 09.09.2021, 14:47
 
Ответить
СообщениеВсем доброго времени суток! Давно уже бьюсь над задачей копирования данных из одной книги в другую, НО с учетом фильтра в одном столбце (фильтр должен быть в файле откуда копируются данные).
У нас с работы просто уволился коллега, который отлично шарил в макросах, но писал довольно непростые коды мягко говоря, для понимания новичка и вот собственно некоторые коды удалось мне переварить и использовать в работе, но вот в одном из кодов наступил конкретный ступор.... :(

Добрые и умные люди, можете, пожалуйста, подсказать где и какие правки нужно внести в код?
Заранее благодарю!

Макрос:

[vba]
Sub Подгрузка_Кред_проц_ЮЛ_ПОС()Dim wbImportFile As WorkbookDim t_Application.ScreenUpdating = FalseApplication.Calculation = xlCalculationManualApplication.EnableEvents = FalseActiveWorkbook.ActiveSheet.DisplayPageBreaks = FalseChDrive Left(ThisWorkbook.Path; 1)ChDir ThisWorkbook.Path & "\"Имяфайла = Application.GetOpenFilename("Excel files(*.xls*),*.xls*"; 1; "Выберите файл 115_099_DD.MM.YY"; ; False)If VarТype(Имяфайла) = vbBoolean Then Exit SubSet wbImportFile = Workbooks.Open(Имяфайла)t_ = Timer'лист в рабочем файле-макросеSet ws = ТhisWorkbook.Worksheets("Кред. проц. ЮЛ ПОС")'лист в файле-доноре; из которого копируется информацияSet ws1 = wbImportFile.Worksheets("Кред. проц. ЮЛ ПОС")kol_str = ws1.Cells(ws1.Rows.Count; 1).End(xlUp).Rowstart_row1 = ws1.Columns("A:A").Find(What:="Портфель"; After:=ws1.Cells(1; 1); LookIn:=xlFormulas; _LookAt:=xlPart; SearchOrder:=xlByRows; SearchDirection:=xlNext; _MatchCase:=False; SearchFormat:=False).Row + 1For i = start_row1 To kol_str'не получается у меня правильно поставить фильтр / условие в 12-ой графе (графа L в файле-доноре); чтобы в этой графе фильтровалось значение «Основной долг» и копировалась бы информация в рабочий файл с учетом этого фильтра.'В разные места это условие пытался ставитьбестолку; на фильтр реакции либо не было; либо копировался всё равно весь массив данных или вообще ничего не копировалось; пробовал вносить всякие правки и корректировки в разные строки кодав итоге макрос писал Debug постоянно….уже не знаю что делать…'If Cells(i; 12).Value = "Основной долг" Thenstart_row = ws.Cells(ws.Rows.Count; 1).End(xlUp).Row + 1ws.Cells(start_row; 1) = ws1.Cells(i; 1)ws.Cells(start_row; 2) = ws1.Cells(i; 2)ws.Cells(start_row; 3) = ws1.Cells(i; 3)ws.Cells(start_row; 4) = ws1.Cells(i; 4)ws.Cells(start_row; 5) = ws1.Cells(i; 5)ws.Cells(start_row; 6) = ws1.Cells(i; 6)ws.Cells(start_row; 7) = ws1.Cells(i; 7)ws.Cells(start_row; 8) = ws1.Cells(i; 8)ws.Cells(start_row; 9) = ws1.Cells(i; 9)ws.Cells(start_row; 10) = ws1.Cells(i; 10)ws.Cells(start_row; 11) = ws1.Cells(i; 11)ws.Cells(start_row; 12) = ws1.Cells(i; 12)ws.Cells(start_row; 13) = ws1.Cells(i; 13)ws.Cells(start_row; 14) = ws1.Cells(i; 14)ws.Cells(start_row; 15) = ws1.Cells(i; 15)ws.Cells(start_row; 16) = ws1.Cells(i; 16)ws.Cells(start_row; 17) = ws1.Cells(i; 17)ws.Cells(start_row; 18) = ws1.Cells(i; 18)ws.Cells(start_row; 19) = ws1.Cells(i; 19)ws.Cells(start_row; 20) = ws1.Cells(i; 20)ws.Cells(start_row; 21) = ws1.Cells(i; 21)ws.Cells(start_row; 22) = ws1.Cells(i; 22)ws.Cells(start_row; 23) = ws1.Cells(i; 23)ws.Cells(start_row; 24) = ws1.Cells(i; 24)ws.Cells(start_row; 25) = ws1.Cells(i; 25)ws.Cells(start_row; 26) = ws1.Cells(i; 26)ws.Cells(start_row; 27) = ws1.Cells(i; 27)ws.Cells(start_row; 28) = ws1.Cells(i; 28)ws.Cells(start_row; 29) = ws1.Cells(i; 29)ws.Cells(start_row; 30) = ws1.Cells(i; 30)ws.Cells(start_row; 31) = ws1.Cells(i; 31)ws.Cells(start_row; 32) = ws1.Cells(i; 32)ws.Cells(start_row; 33) = ws1.Cells(i; 33)ws.Cells(start_row; 34) = ws1.Cells(i; 34)ws.Cells(start_row; 35) = ws1.Cells(i; 35)End IfNext iwbImportFile.Close (False)Application.ScreenUpdating = ТrueApplication.EnableEvents = ТrueMsgBox "Данные подгружены! Время: " & Format((Timer - t_); "0") & " сек."; vbOKOnlyEnd Sub
[/vba]

Автор - Romario
Дата добавления - 09.09.2021 в 14:14
  • Страница 1 из 1
  • 1
Поиск:

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