Код VBA (копирование и вставка из одной таблицы Excel в другую без использования формул)
Я включил скриншоты таблиц ниже. Я практически ничего не знаю о коде VBA, поэтому мне нужна небольшая помощь, чтобы решить проблему.
Итак, в книге 1 в ячейке L15 у нас есть рассчитанный столбец % DT (время простоя) из-за проектирования, который рассчитывается с использованием функций ФИЛЬТР и СУММ.
Было бы здорово, если бы я мог еженедельно переносить эту цифру в столбец C рабочей тетради 2, начиная с ячейки C175, относящейся к текущей неделе (неделя 16). Когда число в ячейке D15 обновляется еженедельно, я бы хотел, чтобы оно добавляло новое число в столбец C (неделя 17, 18....).
Несмотря на небольшую помощь с других форумов, я получил код (ниже), который копирует значения в столбце C только тогда, когда ячейки в B заполнены, и он будет работать только для последнего значения B.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("A28:C315")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Dim desWS As Worksheet, x As Long
Set desWS = Workbooks("Workbook 2.xlsx").Sheets("Update 2023 & 2024 ENG % DT")
x = desWS.Range("B2:B" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row-1
desWS.Range("C" & x) = Range("L15").Value
Application.ScreenUpdating = True
End Sub
Спасибо за помощь, Джоэл
Я попробовал приведенный выше код и не знаю, куда идти дальше.
Рабочая тетрадь 1:
Рабочая тетрадь 2:
Рабочая тетрадь 1 (A28:C315 — Журнал ежедневных отчетов):
Рабочая тетрадь 1 (обновленный столбец):
Отвечает ли это на ваш вопрос? Как избежать использования Select в Excel VBA
Ваш первый скриншот не включает исходный диапазон A28:C315?
@TimWilliams Я включил скриншот части диапазона. Это просто ежедневный журнал отчетов о любых простоях и о том, какой отдел стал причиной простоя.
Ответы 2
Попробуйте это - оно будет соответствовать неделе + году
Private Sub Worksheet_Change(ByVal Target As Range)
Dim destWS As Worksheet, m, wk, yr
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("A28:C315")) Is Nothing Then Exit Sub
Set destWS = Workbooks("Workbook 2.xlsx").Worksheets("Update 2023 & 2024 ENG % DT")
wk = Me.Range("B4").Value
yr = Year(Date)
m = destWS.Evaluate ("MATCH(" & wk & "&" & yr & ",A:A&B:B,0)") 'match week+year
If Not IsError(m) Then 'got a match?
destWS.Cells(m, "C").Value = Me.Range("L15").Value 'fill the value
Else
MsgBox "No match for week = " & wk & " year = " & yr & " !", vbExclamation
End If
End Sub
Это сработало хорошо. Однако ячейка выше обновляется, поскольку в 2021–2024 годах запланировано несколько недель 17 с обновлением в 2021 году. Я подумывал о добавлении столбца с годом и задавался вопросом, как мне обновить код, чтобы также проверить год и связать его с B5 рабочей книги 1. Я добавил обновленное изображение выше.
Будет ли код использовать текущий год для поиска правильной строки?
См. изменения выше, чтобы узнать, как сопоставить оба значения.
Спасибо за помощь. Это работает так, как я хотел. Надеюсь, я чему-то научился в процессе.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim destWS As Worksheet, m, wk, yr
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("A28:C315")) Is Nothing Then Exit Sub
Set destWS = Workbooks("Workbook 2.xlsx").Worksheets("Update 2023 & 2024 ENG % DT")
wk = Me.Range("B4").Value
yr = Me.Range("B5").Value
m = destWS.Evaluate("=MATCH(""wk" & "yr"",A1:A200&B1:B200,0)") 'find the week number in ColA
If Not IsError(m) Then 'got a match?
destWS.Cells(m, "D").Value = Me.Range("L15").Value 'fill the value
Else
MsgBox "No week number match for '" & wk & "' !", vbExclamation
End If
Конец субтитра
Я пробовал этот код, но он, похоже, не работает. Однако, когда я меняю его на это, он делает:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim destWS As Worksheet, m, wk, yr
If Target.CountLarge > 1 Then Exit Sub
If Intersect(Target, Range("A28:C315")) Is Nothing Then Exit Sub
Set destWS = Workbooks("Workbook 2.xlsx").Worksheets("Update 2023 & 2024 ENG % DT")
m = destWS.Evaluate("=MATCH(""17" & "2024"",A1:A200&B1:B200,0)") 'find the week number in ColA
If Not IsError(m) Then 'got a match?
destWS.Cells(m, "D").Value = Me.Range("L15").Value 'fill the value
Else
MsgBox "No week number match for '" & wk & "' !", vbExclamation
End If
Конец субтитра
Я получаю ошибку 2042, которую видел на другой странице, однако попробовал как вариант, так и двойной вариант с предложенными параметрами. (stackoverflow.com/questions/15526784/…)
В настоящее время вы копируете только значение в
Range("L15"). Вам было бы полезно включить примеры данных в виде таблицы или скриншота, поскольку многие люди не будут скачивать файлы из неизвестных источников. Кроме того, если эти ссылки перестанут работать, вопрос станет бесполезным для будущих пользователей S.O.