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

Страницы: 1
Группировка столбцов в зависимости от указанного месяца
 
Добрый день. Ребят подскажите, как можно разгруппировать и группировать столбцы , в зависимости от Индекс "i"
Суть задачи.
12 это  кол-во месяцев и мне необходимо допустим в при Индексе 3 открыть 3 столбца и дальше в той же логике каждый месяц.
Мне необходимо вначале разгруппировать диапазон всех 12 месяцев, т.е. 12 столбцов. Потом сгруппировать уже в зависимости от Индекс(тек. месяца)
Написал ниже код, но возникает проблема. Я разгруппировал весь диапазон и при группировке я выделяю нужный диапазон, но выделенный остаётся так же весь ( 12 месяцев, как при индексе 12) . При группировке нужных столбцов, группируются все 12.
После некоторых изменений начала возникать ошибка
Метод ungroup из класса Range завершён не верно
Помогите решить задачу, буду очень благодарен.
Код
Sub qwe () 
    i = InputBox("Ввести от 1 до 12") 
    Dim  wb As Workbook, shAs Worksheet   
  Set wb= ActiveWorkbook   
  Set sh = ActiveWorkbook.Worksheets(1) 
If i = 1 Then
    sheetS.Columns("AC:AO").Select
    Selection.Columns.Ungroup
    sheetS.Columns("AD:AO").Select
    Selection.Columns.Group
ElseIf i = 2 Then
    sh.Columns("AC:AO").Select
    Selection.Columns.Ungroup
    sh.Columns("AE:AO").Select
    Selection.Columns.Group
End If
End sub 

Копирование значение ячейки из 1 документа в другой ссылкой, VBA Excel
 
Здравствуйте.
Ребят, надеюсь кто-нибудь сможет подсказать. В данном коде необходимо произвести копирование ссылкой, т.е. что бы был виден документ с которого копируешь, лист и ячейка( Пример( ='[Документ.xlsx]"Лист"'!$F$85). Были примеры, как возможно проделать данную операцию, но проблема заключается в том, что у  меня динамические ячейки. При открытии документа всплывает окно, в нём необходимо указать номер и в зависимости от номера, на столько вправа будет вставляться значение.
Есть пример, как делали подобную операцию в другом документе. Но разобраться не смог
Код
sheet1.Cells(i, columnIndex + 1).Value = "='[" & wbOpen.Name & "]" & Sheet.Name & "'!R1C7/25"
Надеюсь, что сможете подсказать, как решить данную задачу. Большое Спасибо!


Код
Sub Macros()Dim filetoopen4 As Variant, file3 As Workbook, sheetS  As Worksheet, a As Variant, file4 As Workbook, Index As Long, i As Long
i = InputBox("Введите от 1 до 12)
    Set file3 = Workbooks("Start")
    Set sheetS = Workbooks("Start").Worksheets("List")
    Workbooks("Start").Worksheets("List").Activate
    a = sheetS.Cells(1, 24)
    filetoopen4 = Application.GetOpenFilename(Title:="?????")
    If filetoopen4 <> False Then
        Set file4 = Workbooks.Open(filetoopen4)
    Dim wb As Workbook, sh As Worksheet: Set wb = ActiveWorkbook: Set sh = wb.Worksheets("xmao")
            With sheetS
                .Cells(119, 28 + i) = sh.Cells(21, 3).Value/1000
                .Cells(120, 28 + i) = sh.Cells(28, 3).Value/1000
                .Cells(121, 28 + i) = sh.Cells(31, 3).Value/1000
                .Cells(119, 28 + i) = sh.Cells(21, 1).Value/1000
                .Cells(120, 28 + i) = sh.Cells(28, 1).Value/1000
                .Cells(121, 28 + i) = sh.Cells(31, 1).Value/1000
                .Cells(119, 28 + i) = sh.Cells(70, 2).Value
                .Cells(120, 28 + i) = sh.Cells(78, 2).Value
                .Cells(121, 28 + i) = sh.Cells(80, 2).Value
                .Cells(119, 28 + i) = sh.Cells(21, 6).Value
                .Cells(120, 28 + i) = sh.Cells(28, 6).Value
                .Cells(121, 28 + i) = sh.Cells(31, 6).Value
                .Cells(119, 28 + i) = sh.Cells(70, 11).Value
                .Cells(120, 28 + i) = sh.Cells(78, 11).Value
                .Cells(121, 28 + i) = sh.Cells(80, 11).Value
                .Cells(119, 28 + i) = sh.Cells(70, 10).Value/1000
                .Cells(120, 28 + i) = sh.Cells(78, 10).Value/1000
                .Cells(121, 28 + i) = sh.Cells(80, 10).Value/1000
                .Cells(121, 28 + i) = sh.Cells(80, 1).Value
          End With
            End If
    wb.Close (False)
End Sub
Копирование с 1 документа на другой ссылкой, VBA Excel
 
В мом коде происходит копирование значения файла и вставка. А я хочу ссылкой, что бы можно было произвести арифметическое действие (поделить на 1000) или другой способ копирования, который позволит мне это сделать
Копирование с 1 документа на другой ссылкой, VBA Excel
 
Здравствуйте.
Ребят подскажите, пожалуйста.  Написал код, но не могу  доработать один момент .
Необходимо, что бы в строку
Код
 .Cells(119, 28 + i)
 скопировалось значение поделённое на 1000 Пример
Код
.Cells(119, 28 + i) /1000
из строки
Код
sh.Cells(21, 3).Value
Данные строки находятся в разных документах.
ребят подскажите, как решить данную задачу. Долго голову ломал, не могу разобраться, как это сделать. Заранее большое спасибо
Ниже приведён полный код, для понимания
Код
Sub Macros()Dim filetoopen4 As Variant, file3 As Workbook, sheetS  As Worksheet, a As Variant, file4 As Workbook, Index As Long, i As Long
i = InputBox("??????? ???????? ?? 1 ?? 12")
    Set file3 = Workbooks("Start")
    Set sheetS = Workbooks("Start").Worksheets("List")
    Workbooks("Start").Worksheets("List").Activate
    a = sheetS.Cells(1, 24)
    filetoopen4 = Application.GetOpenFilename(Title:="?????")
    If filetoopen4 <> False Then
        Set file4 = Workbooks.Open(filetoopen4)
    Dim wb As Workbook, sh As Worksheet: Set wb = ActiveWorkbook: Set sh = wb.Worksheets("xmao")
            With sheetS
                .Cells(119, 28 + i) = sh.Cells(21, 3).Value
                .Cells(120, 28 + i) = sh.Cells(28, 3).Value
                .Cells(121, 28 + i) = sh.Cells(31, 3).Value
                .Cells(119, 28 + i) = sh.Cells(21, 1).Value
                .Cells(120, 28 + i) = sh.Cells(28, 1).Value
                .Cells(121, 28 + i) = sh.Cells(31, 1).Value
                .Cells(119, 28 + i) = sh.Cells(70, 2).Value
                .Cells(120, 28 + i) = sh.Cells(78, 2).Value
                .Cells(121, 28 + i) = sh.Cells(80, 2).Value
                .Cells(119, 28 + i) = sh.Cells(21, 6).Value
                .Cells(120, 28 + i) = sh.Cells(28, 6).Value
                .Cells(121, 28 + i) = sh.Cells(31, 6).Value
                .Cells(119, 28 + i) = sh.Cells(70, 11).Value
                .Cells(120, 28 + i) = sh.Cells(78, 11).Value
                .Cells(121, 28 + i) = sh.Cells(80, 11).Value
                .Cells(119, 28 + i) = sh.Cells(70, 10).Value
                .Cells(120, 28 + i) = sh.Cells(78, 10).Value
                .Cells(121, 28 + i) = sh.Cells(80, 10).Value
           End With
    End If
    wb.Close (False)
End Sub
Вставка значений ячеек в формулу, VBA Excel
 
А через данную команду скопировать не получится ?
Код
.Cells(21, 3).Value = sheetS.Cells(119, 28 + i)
Если копировать через Paste Special, то нужно постоянно  активировать 1 ,  а потом 2 документ. А если учесть, что  у меня порядка 23 ячеек необходимо копировать, то выйдет крайне громоздкий код.
И не подскажите, как можно скопировать значение  в формулу или преобразовать в формулу. Что бы значение "х" из 1 документа копировалось во второй формулой "х/10"
"х"- значение которое копируем

Вставка значений ячеек в формулу, VBA Excel
 
Суть задачи заключается в следующем.
Как скопировать только значение. Т.к. в 1 документе шрифт и размер данных в ячейке отличаются от 2 . Пробовал
Код
.Cells(21, 3).Copy sheetS.Cells(119, 28 + i)
Пробовал  копировать подобным образом, но копирования не произошло.
Код
.Cells(21, 3).Value = sheetS.Cells(119, 28 + i)
И как можно скопировать это значение формулой. Что бы значение из 1 документа копировалось во второй формулой х/10
х- значение которое копируем
Пробовал делать подобным образом, но выдает ошибку
Код
.Cells(21, 3).Copy sheetS.Cells(119, 28 + i)/1000 
Большое спасибо.
Вставка значений ячеек в формулу, VBA Excel
 
Добрый вечер.Недавно начал заниматься программированием VBA и столкнулся со следующей ситуаций .
Необходимо из 1 документа скопировать значения в другой документ(Пример из А1 документа первый в А4/10 документа второй.Значение будет копироваться на А4, в результате чего  будет производиться деление с обновлёнными данными)

Заранее большое спасибо!
Код
Dim filetoopen4 As Variant, file3 As Workbook, sheetS  As Worksheet, a As Variant, file4 As Workbook, Index As Long, i As Long
i = InputBox("Ввести от 1 до 12")
    Set file3 = Workbooks("1")
    Set sheetS = Workbooks("1").Worksheets("2")
    Set sheetV7 = Workbooks("1").Worksheets("3")
    Workbooks("1").Worksheets("2").Activate
    sheetS.Range("AQ1") = i
    filetoopen4 = Application.GetOpenFilename(Title:="?????")
    If filetoopen4 <> False Then
        Set file4 = Workbooks.Open(filetoopen4)
    Dim wb As Workbook, sh As Worksheet: Set wb = ActiveWorkbook: Set sh = wb.Worksheets("ХМАО")
    Dim sh1 As Worksheet: Set sh1 = wb.Worksheets("в")
    Dim sh2 As Worksheet: Set sh2 = wb.Worksheets("С")
    Dim sh3 As Worksheet: Set shG = wb.Worksheets("Г")
    Dim sh4 As Worksheet: Set shC = wb.Worksheets("ц")
            With sh
                .Cells(21, 3).Copy sheetS.Cells(119, 28 + i)
                .Cells(28, 3).Copy sheetS.Cells(120, 28 + i)
                .Cells(31, 3).Copy sheetS.Cells(121, 28 + i)
                .Cells(21, 1).Copy sheetS.Cells(129, 28 + i)
                .Cells(28, 1).Copy sheetS.Cells(130, 28 + i)
                .Cells(31, 1).Copy sheetS.Cells(131, 28 + i)
                .Cells(70, 2).Copy sheetS.Cells(134, 28 + i)
                .Cells(77, 2).Copy sheetS.Cells(135, 28 + i)
                .Cells(80, 2).Copy sheetS.Cells(136, 28 + i)
                .Cells(21, 6).Copy sheetS.Cells(140, 28 + i)
                .Cells(28, 6).Copy sheetS.Cells(141, 28 + i)
                .Cells(31, 6).Copy sheetS.Cells(142, 28 + i)
                .Cells(70, 11).Copy sheetS.Cells(146, 28 + i)
                .Cells(77, 11).Copy sheetS.Cells(147, 28 + i)
                .Cells(80, 11).Copy sheetS.Cells(148, 28 + i)
                .Cells(70, 10).Copy sheetS.Cells(158, 28 + i)
                .Cells(77, 10).Copy sheetS.Cells(159, 28 + i)
                .Cells(80, 10).Copy sheetS.Cells(160, 28 + i)
            End With
                 sh1.Cells(46, 3).Copy sheetS.Cells(111, 28 + i)
                 sh1.Cells(21, 3).Copy sheetV7.Cells(111, 28 + i)
                 sh2.Cells(13, 10).Copy sheetS.Cells(113, 28 + i)
                 shC.Cells(15, 4).Copy sheetV7.Cells(113, 28 + i)
                 shG.Cells(22, 14).Copy sheetV7.Cells(109, 28 + i)
                 
        End If
    wb.Close (False)
Копирование двумерного массива(VBA), КОпирование двумерного массива в другой документ Excel (VBA)
 
Большое спасибо. Ребят ещё 2 вопросика. Размер и шрифт 1 и 2 документа отличаются. Какая команда поможет произвести копирование с изменением формата .относительного того документа, в который копируем данные.
И если про копировании в документе 2 у меня стоит формула, как вставить значение ? (Пример- копирую ячейку "А1" из док1. в док.  В док. 2 стоит формула "А1/10". Я хочу вставить  значение и что бы формула просчиталась. Условно у меня стоит в док 1 значение 10, а при копировании в док.2 значение уже будет 1, т.к. произошло деление на 10)
Большое спасибо за помощь!
Код
        Sub Macros()
Dim filetoopen4 As Variant, file3 As Workbook, sheetS  As Worksheet, a As Variant, file4 As Workbook, Index As Long, i As Long
i = InputBox("Vvedite ot 1 do 12")
    Set file3 = Workbooks("1")
    Set sheetS = Workbooks("1").Worksheets("11")
    Workbooks("1").Worksheets("11").Activate
    a = sheetS.Cells(1, 24)
    filetoopen4 = Application.GetOpenFilename(Title:="?????")
    If filetoopen4 <> False Then
        Set file4 = Workbooks.Open(filetoopen4)
    Dim wb As Workbook, sh As Worksheet: Set wb = ActiveWorkbook: Set sh = wb.Worksheets("XMAO")
            With sheetS
            sh.Cells(21, 3).Copy sheetS.Cells(119, 28 + i)
'                
            End With
'           End If
    wb.Close (False)
End Sub
Изменено: Игорь Нигматулин - 15.05.2021 16:24:31
Копирование двумерного массива(VBA), КОпирование двумерного массива в другой документ Excel (VBA)
 
В документ "Start" мы копируем данные с документа "Файл с которого копируем".
Задумка программы следующая. Человек вбивает число от 1  до 12 (число месяцев в году, вбиваем в ячейку AQ1 ) и при активации программы, всплывает окно с просьбой выбрать  необходимый документ, с которого будем копировать данные.  В данном документе я с помощью двумерного массива хотел выделить необходимые ячейки с данными и скопировать их в документ "Start".
Таблица в которую необходимо копировать находиться в диапазоне ячеек AC117: AO155. Документ Start
Ячейки которые необходимо копировать находятся : A 21,28,21. C 21.28,31. F 21,28,31. B 70,77,80. J70,77,80.K 70,77,80. Документ Start "Файл с которого копируем"
Данный процесс копирования подойдёт для моего случая ?)
Код
Workbooks("ИмяКниги1").Worksheets("ИмяЛистаВКниге1").Range("АдресДиапазона").Copy Workbooks("ИмяКниги2").Worksheets("ИмяЛистаВКниге2").Range("АдресЯчейки")
Копирование двумерного массива(VBA), КОпирование двумерного массива в другой документ Excel (VBA)
 
Большое спасибо за код, процесс проходит без ошибок, но не происходит самого процесса копирования из  sh.Cells(21, 3)  в Cells(119, 28 + i).
Ребят, подскажите, как совершить копирование.
Спасибо!
Код
Sub Macros()
Dim filetoopen4 As Variant, file3 As Workbook, sheetS  As Worksheet, a As Variant, file4 As Workbook, Index As Long, i As Long
i = InputBox("??????? ???????? ?? 1 ?? 12")
    Set file3 = Workbooks("Start")
    Set sheetS = Workbooks("Start").Worksheets("List")
    Workbooks("Start").Worksheets("List").Activate
    a = sheetS.Cells(1, 24)
    filetoopen4 = Application.GetOpenFilename(Title:="?????")
    If filetoopen4 <> False Then
        Set file4 = Workbooks.Open(filetoopen4)
    Dim wb As Workbook, sh As Worksheet: Set wb = ActiveWorkbook: Set sh = wb.Worksheets("xmao")
            With sheetS
                .Cells(119, 28 + i) = sh.Cells(21, 3)
                .Cells(120, 28 + i) = sh.Cells(28, 3)
                .Cells(121, 28 + i) = sh.Cells(31, 3)
                .Cells(119, 28 + i) = sh.Cells(21, 1)
                .Cells(120, 28 + i) = sh.Cells(28, 1)
                .Cells(121, 28 + i) = sh.Cells(31, 1)
                .Cells(119, 28 + i) = sh.Cells(70, 2)
                .Cells(120, 28 + i) = sh.Cells(78, 2)
                .Cells(121, 28 + i) = sh.Cells(80, 2)
                .Cells(119, 28 + i) = sh.Cells(21, 6)
                .Cells(120, 28 + i) = sh.Cells(28, 6)
                .Cells(121, 28 + i) = sh.Cells(31, 6)
                .Cells(119, 28 + i) = sh.Cells(70, 11)
                .Cells(120, 28 + i) = sh.Cells(78, 11)
                .Cells(121, 28 + i) = sh.Cells(80, 11)
                .Cells(119, 28 + i) = sh.Cells(70, 10)
                .Cells(120, 28 + i) = sh.Cells(78, 10)
                .Cells(121, 28 + i) = sh.Cells(80, 10)
           End With
    End If
    wb.Close (False)
End Sub
Копирование двумерного массива(VBA), КОпирование двумерного массива в другой документ Excel (VBA)
 
XMAO  - это Лист 1 в документе с которого копируем. Сам документ на работе, это лишь макет

Цитата
Человек вбивает число от 1  до 12 куда вбивается? где это в макросе ?
Вбивает число вручную, после чего запускает макрос

Цитата
Mershik написал: а вот эта часть и ниже вообще не понятно что это  для чего
Попытка скопировать данные с ячеек с помощью двумерного массива . Но это неправильно, как мне кажется, Можете подсказать, как именно это сделать  
Копирование двумерного массива(VBA), КОпирование двумерного массива в другой документ Excel (VBA)
 
В документ "Start" мы копируем данные с документа "Файл с которого копируем".
Задумка программы следующая. Человек вбивает число от 1  до 12 (число месяцев в году, вбиваем в ячейку AQ1 ) и при активации программы, всплывает окно с просьбой выбрать  необходимый документ, с которого будем копировать данные.  В данном документе я с помощью двумерного массива хотел выделить необходимые ячейки с данными и скопировать их в документ "Start".
Таблица в которую необходимо копировать находиться в диапазоне ячеек AC117: AO155. Документ Start
Ячейки которые необходимо копировать находятся : A 21,28,21. C 21.28,31. F 21,28,31. B 70,77,80. J70,77,80.K 70,77,80. Документ Start "Файл с которого копируем"
Изменено: Игорь Нигматулин - 13.05.2021 20:42:50
Копирование двумерного массива(VBA), КОпирование двумерного массива в другой документ Excel (VBA)
 
Здравствуйте. Хотелось бы заранее отметить, что владею слабым уровнем знаний VBA. Не судите строго, за плохой код. Необходимо написать программу для копирования ячеек из 1 документа в другой. Копирование будет происходить в зависимости от месяца.При январе, в ячейке QA1 будет стоять число 1 , в результате  данные будут копироваться в определённые ячейки. Ячейки, с документа  которого планируем копировать, не изменяют своего положения каждый месяц. Решил сделать это с помощью двумерного массива.
Возникла ошибка "object doesn't support this property or method " в строке кода:
Код
For Each CopyRange In sheetS("xmao").Range("AE119:AE161")А так же Sub or function not defined

А так же "sub of function not defined" в строке кода:

Код
СopyRange(70, 10).Value = Workbooks("Start").Range(158, 27 + i).Select
Так же затрудняюсь как скопировать отдельные ячейки из двумерного массива в другой документ. Решил проблему подобным планом, до неё из-за ошибок пока не дошёл. Интересно ваше мнение, правильно ли написал и сработает ли код.
Заранее спасибо за получению инфорацию.
Код
Sub Macros()
Dim filetoopen4 As Variant, file3 As Workbook, sheetS  As Worksheet, a As Variant, file4 As Workbook, Index As Long, i As Long
    Set file3 = Workbooks("Start")
    Set sheetS = Workbooks("Start").Worksheets("List")
    Workbooks("Start").Worksheets("List").Activate
    a = Workbooks("Start").Worksheets("List").Cells(1, 24)
    filetoopen4 = Application.GetOpenFilename(Title:="Отчёт")
        If filetoopen4 <> False Then
    Set file4 = Workbooks.Open(filetoopen4)
          If Index = i Then
            Dim DimArr(1 To 91, 1 To 39) As Double
            Dim CopyRange As Range
                For Each CopyRange In sheetS("xmao").Range("AE119:AE161")
                DimArr(CopyRange.Row, CopyRange.Column) = CopyRange
                    CopyRange(21, 3).Value = Workbooks("Start").Range(119, 27 + i).Select
                    CopyRange(28, 3).Value = Workbooks("Start").Range(120, 27 + i).Select
                    CopyRange(31, 3).Value = Workbooks("Start").Range(121, 27 + i).Select
                    CopyRange(21, 1).Value = Workbooks("Start").Range(129.27 + i).Select
                    CopyRange(28, 1).Value = Workbooks("Start").Range(130.27 + i).Select
                    CopyRange(31, 1).Value = Workbooks("Start").Range(131, 27 + i).Select
                    CopyRange(70, 2).Value = Workbooks("Start").Range(134, 27 + i).Select
                    CopyRange(77, 2).Value = Workbooks("Start").Range(135, 27 + i).Select
                    CopyRange(80, 2).Value = Workbooks("Start").Range(136, 27 + i).Select
                    CopyRange(21, 6).Value = Workbooks("Start").Range(140, 27 + i).Select
                    CopyRange(28, 6).Value = Workbooks("Start").Range(141, 27 + i).Select
                    CopyRange(31, 6).Value = Workbooks("Start").Range(142, 27 + i).Select
                    CopyRange(70, 11).Value = Workbooks("Start").Range(146, 27 + i).Select
                    CopyRange(77, 11).Value = Workbooks("Start").Range(147, 27 + i).Select
                    CopyRange(80, 11).Value = Workbooks("Start").Range(148, 27 + i).Select
                    СopyRange(70, 10).Value = Workbooks("Start").Range(158, 27 + i).Select
                    CopyRange(77, 10).Value = Workbooks("Start").Range(159, 27 + i).Select
                    CopyRange(80, 10).Value = Workbooks("Start").Range(160, 27 + i).Select
                    Next CopyRange
                    End If
        file3.Close (False)
        End If
End Sub

Страницы: 1
Наверх