Страницы: 1
RSS
Вставка значений ячеек в формулу, 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 только начали осваивать, русским равно пользуетесь? вот с его помощью и обьясните суть задачи
Изменено: Ігор Гончаренко - 16.05.2021 00:01:47
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Суть задачи заключается в следующем.
Как скопировать только значение. Т.к. в 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 
Большое спасибо.
 
Цитата
Игорь Нигматулин написал:
Как скопировать только значение. Т.к. в 1 документе шрифт и размер данных в ячейке отличаются от 2
используйте пастспешил https://vremya-ne-zhdet.ru/vba-excel/vyrezaniye-kopirovaniye-vstavka-yacheyek/.

пы.сы. снова без примера...
Изменено: Mershik - 16.05.2021 15:11:29
Не бойтесь совершенства. Вам его не достичь.
 
А через данную команду скопировать не получится ?
Код
.Cells(21, 3).Value = sheetS.Cells(119, 28 + i)
Если копировать через Paste Special, то нужно постоянно  активировать 1 ,  а потом 2 документ. А если учесть, что  у меня порядка 23 ячеек необходимо копировать, то выйдет крайне громоздкий код.
И не подскажите, как можно скопировать значение  в формулу или преобразовать в формулу. Что бы значение "х" из 1 документа копировалось во второй формулой "х/10"
"х"- значение которое копируем

 
Это можно бы сделать по этой схеме:

Код
Option Explicit

Sub a_b_frml()
    
    Const xlALst = "List1" 'Otkuda
    Const xlBLst = "List1" 'Gde
    Const prcsn = "3"      'Tochnost' rezul'tata v formule
    
    Dim f_rm: f_rm = Application.GetOpenFilename("Fayle xls (*.xls*),*.xls*", , "Otkuda")
            If f_rm = False Then Exit Sub
    Dim t_o: t_o = Application.GetOpenFilename("Fayle xls (*.xls*),*.xls*", , "Gde")
            If t_o = False Then Exit Sub
    
    Application.DisplayAlerts = False
        Application.AskToUpdateLinks = False
            Dim wkA As Workbook: Set wkA = Workbooks.Open(f_rm, 0, True) 'Otkuda
            Dim wkB As Workbook: Set wkB = Workbooks.Open(t_o, 0, False) 'Gde
        Application.AskToUpdateLinks = True
    Application.DisplayAlerts = True
    
    f_rm = Array("A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10")        'yacheyki - otkuda
    t_o = Array("A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10")         'yacheyki - gde
    Dim d: d = Array("1.1", "0.9", "2.4", "3.9", "4.2", "5", "6.7", "7.8", "8", "9") 'deliteli chisel
    
    Dim ix As Long: ix = LBound(f_rm)
    Dim iy As Long: iy = UBound(f_rm)
    Dim i As Long, tbl: ReDim tbl(ix To iy)
    
    For i = ix To iy
        tbl(i) = wkA.Sheets(xlALst).Range(f_rm(i)).Value
        If Not IsNumeric(tbl(i)) Then tbl(i) = Val(Replace(tbl(i), ",", ".", 1, -1, 0))
    Next
    
    wkA.Close False: Set wkA = Nothing
    
    Application.ScreenUpdating = False
        For i = ix To iy
            wkB.Sheets(xlBLst).Range(t_o(i)).Formula = "=ROUND(" & tbl(i) & "/" & d(i) & "," & prcsn & ")"
        Next
    Application.ScreenUpdating = True
    
    Set wkB = Nothing
    
End Sub
 
ocet p,
на хрен в вашем макросе
   t_o = Array("A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10")         'yacheyki - gde
если строкой выше
   f_rm = Array("A1", "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9", "A10")        'yacheyki - otkuda
это одно и то же
вы не знаете чем себя занять? а за одно и занять VBA
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко,  :D вот, кстати, да
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Цитата
Ігор Гончаренко написал:
это одно и то же
Подумайте, прежде чем писать что-нибудь.
Если ячейки, в которые должны быть скопированы данные, будут отличатся (от тех, которые я ввел), это то же самое для вас ?
Например:
Код
t_o = Array("AA1", "AA2", "AA3", "AA4", "AA5", "AA6", "AA7", "AA8", "AA9", "AA10")

'или

t_o = Array("B1", "E2", "J3", "D4", "A5", "Z6", "X7", "U8", "F9", "I10")

'и так далее
 
Я тоже не понял... Почему после 20-й строки не использовать один массив вместо создания двух?
Страницы: 1
Наверх