3

Начну с того, что я пытаюсь сэкономить время для члена семьи, который делает эту программу вручную.

Лист 1

  1. Столбец А - дата начала
  2. Столбец B - предполагаемая дата начала
  3. Столбец E является именем задачи.

Лист 2 - календарь ручной работы.

  1. Задачи находятся в B8:B17 для предполагаемой даты начала и B20:B29 для фактической даты начала
  2. Неделя C5:AK5, Месяц C6:AK6, День C7:AK7

То, что я пытаюсь сделать, это:

IF cell change in sheet_1(range a2:a999)

Find in sheet 3 (C6:AK7) the location of value entered in sheet 2(active.cell)
    Store column number as Actual_Date_y
Active.Cell
    move active.cell to Location (R,C+4)
    Find in sheet 3 (B20:B29)the String from new active.cell
        Store Row Number as Actual_Date_x

print ("X"), in (Actual_Date_x,Actual_Date_y)

Я рыба из воды, когда дело доходит до VBA.

@jcbermu - Проект длится 35 недель (C:AK - 35 столбцов). В строке 5 есть номер недели (1-35) (ячейки C5:AK5), затем у него есть месяц в C6:AK6, наконец, у него есть календарная воскресная дата в C7:AK7, как показано здесь:
скриншот таблицы

РЕДАКТИРОВАТЬ: @Raystafarian, СПАСИБО, это читается как именно то, что мне нужно. Я собираюсь попробовать и посмотреть, что произойдет.

  • @Raystafarian, "не найден" каждый раз. Я собираюсь сказать, что это его формат для дат, так как между листами нет преемственности. Я собираюсь настроить его листы и посмотреть, решит ли это проблему.

2 ответа2

0

В буквальном смысле, то, что вы хотите, переводится в нечто вроде этого в модуле рабочего листа для листа 1 -

Sub worksheet_change(ByVal target As Range)

Dim actdatex As Integer
Dim actdatey As Integer
Dim newcell As Range
Dim rngdate As Range



If Not Intersect(target, Range("A2:A999")) Is Nothing Then
On Error GoTo handler
 For Each c In Range("Sheet3!C6:AK7")
    If c = Worksheets("Sheet2").Range(target.Address) Then
     actdatex = c.Column
     Exit For
    End If
 Next

 Set newcell = Range(target).Offset(, 4)

 For Each d In Range("Sheet3!B20:B29")
    If d = newcell Then
        actdatey = d.Row
    Exit For
    End If
 Next

 Set rngdate = Cells(actdatex, actdatey)
 rngdate = "X"

End If


handler:
MsgBox ("not found")
End Sub
0

Попробуй это:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim wkb As Workbook
Dim wks As Worksheet
Dim wks1 As Worksheet
Dim cell1, cell2, myrange As Range
Set wkb = ThisWorkbook
Set wks = wkb.Sheets(1)
Set wks1 = wkb.Sheets(2)
targetrow = Target.Row
targetcolumn = Target.Column
task = wks.Cells(targetrow, 3)
For i = 3 To 300
    a = wks1.Cells(6, i)
    If a = "" Then
        i = 301
    End If
    If a = Target.Value Then
        initialrow = 20
        If targetcolumn = 2 Then
            initialrow = initialrow - 12
        End If
        realrow = initialrow + targetrow - 2
        For j = 3 To 300
            wks1.Cells(realrow, j) = ""
            If wks1.Cells(6, j) = "" Then
                j = 301
            End If
        Next j
        wks1.Cells(realrow, i) = "X"
    End If
Next i
End Sub

Работает только при некоторых условиях:

  1. На Листе 1 столбцы должны быть в следующем порядке: Start Date | Projected Date | Task Name
  2. На Листе 2 month и Sunday date должны совпадать.

    Я приведу вам пример: в ячейку C6 и ячейку c7 вы помещаете 01.03.2015 и, используя формат ячейки, выбираете custom и используете mmm на c6 и dd на C7.

  3. Порядок задач должен быть одинаковым на Лист1 и Лист2.

  4. На Листе 2 первое задание должно быть в ячейках B8 и B20 .

Код VBA должен быть указан на листе 1. Вам нужно открыть макросы и в левом столбце дважды щелкнуть лист, а затем вставить код с правой стороны. Всякий раз, когда дата изменяется на Sheet1 она обновляется на Sheet2 .

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .