Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 16.09.2023, 17:00   #1
Ivan Aprincev
Новичок
Джуниор
 
Регистрация: 16.09.2023
Сообщений: 2
Сообщение Изменение макроса

Добрый день всем!

Совсем не справляюсь без помощи (

Есть книга с двумя листами. Первый - "Данные", а второй - "Отчет"

Мне нужно, чтобы в приведенном ниже коде изменить его так, чтобы ...
1) На лист «Отчет» копировались данные в диапазоне A-I столбов, включая A столбец, проверяя наличие числовых данных в «H» столбце
2) сейчас он копирует значения в диапазоне "B-I" начиная со столбца B:B на лист "Отчет"... а как сделать так, чтобы он делал то же самое, но копировал начиная со столбца A:A?
3) При этом скрипт сейчас проверяет наличие данных в «A» столбце, а нужно чтобы эта проверка была по «H» столбцу

Private Sub Worksheet_Activate()
Dim a(), i&, ii&, x&
UsedRange.Clear
With Sheets(1)
a = .Range(.[I1], .Range("A" & .Rows.Count).End(IIf(Len(.Range("A" & .Rows.Count)), xlDown, xlUp))).Value
End With
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
For i = 1 To UBound(a)
If Len(a(i, 1)) Then
ii = ii + 1
For x = 2 To UBound(a, 2): b(ii, x) = a(i, x): Next
End If
Next
If ii > 0 Then [A1].Resize(ii, UBound(b, 2)) = b
End Sub

Жду и надеюсь))
Ivan Aprincev вне форума Ответить с цитированием
Старый 17.09.2023, 00:07   #2
Ivan Aprincev
Новичок
Джуниор
 
Регистрация: 16.09.2023
Сообщений: 2
По умолчанию

Private Sub Worksheet_Activate()
Dim a(), i&, ii&, x&
UsedRange.Clear
With Sheets(1)
a = .Range(.[I1], .Range("A" & .Rows.Count).End(IIf(Len(.Range("A" & .Rows.Count)), xlDown, xlUp))).Value
End With
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
For i = 1 To UBound(a)
If Len(a(i, 8)) < 1 Then
ii = ii + 1
b(ii, 1) = a(i, 1)
b(ii, 2) = a(i, 2)
b(ii, 3) = a(i, 3)
b(ii, 4) = a(i, 4)
b(ii, 5) = a(i, 5)
b(ii, 6) = a(i, 6)
b(ii, 7) = a(i, 7)
End If
Next
If ii > 0 Then [A1].Resize(ii, UBound(b, 2)) = b
End Sub

Сам допытал ответ
Ivan Aprincev вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Изменение макроса Михаил332 Microsoft Office Excel 2 11.01.2020 21:55
Изменение макроса для копирования данных simi Microsoft Office Excel 4 28.11.2016 11:53
Изменение макроса scratik Microsoft Office Excel 6 23.06.2011 15:24
Изменение макроса Vaniq Microsoft Office Excel 2 25.08.2009 13:45