Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Как сделать адрес диапозона переменным/динамичным, VBA
 
#1
26.05.2020 17:27:32
Доброго времени суток.

Прошу прощения за топорную формулировку впроса. Есть вот такой фаил.
Когда меняесться переменная в значение в ячейке "F2", таким образом мы выбираем какие колонки копировать из Sheets("data")
Вопрос. Как сделать это динамичным?

Фаил приложен.
Будте здорово и спасибо!
Код
Sub test()
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet

        Set wsCopy = Sheets("data")
        Set wsDest = Sheets("cover")
        
        Sheets("data").Activate
        
            'Сейчас работает так:
            wsCopy.Range(Range("A:A"), Range("A:A").End(xlDown)).Copy wsDest.Range("K:K")
            wsCopy.Range(Range("D:D"), Range("D:D").End(xlDown)).Copy wsDest.Range("L:L")
            wsCopy.Range(Range("F:F"), Range("F:F").End(xlDown)).Copy wsDest.Range("M:M")
            
            'Примерно нужно вот такое:
            'wsCopy.Range(Range(Range("range_1").Value), Range(Range("range_1").Value).End(xlDown)).Copy wsDest.Range("K:K")
            'wsCopy.Range(Range(Range("range_2").Value), Range(Range("range_2").Value).End(xlDown)).Copy wsDest.Range("L:L")
            'wsCopy.Range(Range(Range("range_3").Value), Range(Range("range_3").Value).End(xlDown)).Copy wsDest.Range("M:M")
            
        Sheets("cover").Activate
End Sub
 
 
 
#2
26.05.2020 17:58:24
Цитата
Как сделать это динамичным?
Для вашего примера макрос в модуль листа cover
Код
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("F2")) Is Nothing Then
    Application.EnableEvents = False
Dim iLastRow As Long
  With Worksheets("data")
    iLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
   Select Case Target
     Case "вариант A"
       .Range("A1:A" & iLastRow).Copy Range("K1")
       .Range("D1:D" & iLastRow).Copy Range("L1")
       .Range("F1:F" & iLastRow).Copy Range("M1")
     Case "вариант B"
       .Range("D1:D" & iLastRow).Copy Range("K1")
       .Range("F1:F" & iLastRow).Copy Range("L1")
       .Range("C1:C" & iLastRow).Copy Range("M1")
   End Select
  End With
 End If
    Application.EnableEvents = True
End Sub

Срабатывает при изменении содержимого ячейки F2
 
 
 
#3
26.05.2020 22:06:51
Цитата
Kuzmich написал:
Для вашего примера макрос
Спасибо огромное! Очень помогло.
 
 
 
#4
26.05.2020 22:29:09
Вот так, выкрутился.

Еще раз спасибо!!!
Код
Sub copy_filtered_data_1()
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lo As ListObject
    Dim iCol_1 As Long
    Dim iCol_2 As Long
    Dim iCol_3 As Long
    Dim wsMapping As Worksheet

        Set wsCopy = Worksheets(Range("Sheet_name_support").Value)
        Set wsDest = Worksheets("dev_v1")
        Set lo = ActiveSheet.ListObjects(1)
        
        Worksheets(Range("Sheet_name_support").Value).Activate

            iCol_1 = lo.ListColumns(Range("dev_1_column1").Value).Index
            iCol_2 = lo.ListColumns(Range("dev_1_column2").Value).Index
            iCol_3 = lo.ListColumns(Range("dev_1_column3").Value).Index

        wsCopy.ListObjects(1).ListColumns(iCol_1).DataBodyRange.Copy wsDest.Range("I11")
        wsCopy.ListObjects(1).ListColumns(iCol_2).DataBodyRange.Copy wsDest.Range("K11")
        wsCopy.ListObjects(1).ListColumns(iCol_3).DataBodyRange.Copy wsDest.Range("D11")
End Sub
 
 
 
Страницы: 1
Наверх