Pemrograman Excel 2013 VBA

Saya akan memulai perkataan saya, saya mencoba menghemat waktu untuk anggota keluarga yang melakukan program ini secara manual.

Lembar 1

1. Kolom A adalah tanggal mulai
2. Kolom B adalah tanggal mulai yang diproyeksikan
3. Kolom E adalah Nama Tugas.

Lembar 2 adalah kalender buatan tangan.

1. Tugas ada di B8: B17 untuk tanggal mulai yang Diproyeksikan dan B20: B29 untuk tanggal mulai yang Sebenarnya
2. Minggu adalah C5: AK5, Bulan adalah C6: AK6, Hari adalah C7: AK7

Apa yang saya coba lakukan adalah:

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)

Saya ikan dari air ketika datang ke VBA.

@ jcbermu - Proyek ini berdurasi 35 minggu (C: AK 35 kolom). Ada nomor minggu (1-35) di baris 5 (sel C5: AK5), maka ia memiliki bulan di C6: AK6, terakhir ia memiliki kalender pada hari Minggu di C7: AK7, seperti yang terlihat di sini:

EDIT: @Raystafarian, TERIMA KASIH, ini berbunyi seperti yang saya butuhkan. Saya akan mencobanya dan melihat apa yang terjadi.

• @Raystafarian, "tidak ditemukan" setiap saat. Saya akan mengatakan itu format untuk tanggal karena tidak ada kontinuitas antara lembar Saya akan mengubah lembarannya dan melihat apakah itu memperbaiki masalah.

Secara harfiah, apa yang Anda inginkan diterjemahkan menjadi seperti ini di modul lembar kerja untuk lembar 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

Coba ini:

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

Ini hanya berfungsi dalam beberapa kondisi:

1. Di Sheet1 kolom harus dalam urutan ini: Start Date | Projected Date | Task Name.

2. Di Sheet2 itu month dan Sunday date harus sama saja.

   Saya akan memberi Anda contoh: Di sel C6 dan sel c7 Anda menaruh 01/03/2015 dan menggunakan format sel yang Anda pilih adat dan gunakan mmm pada c6 dan dd pada C7.

3. Urutan tugas harus sama pada Sheet1 dan Sheet2 .

4. Di Sheet2 tugas pertama harus di sel B8 dan B20.

Kode VBA harus dipakai Lembar 1 . Anda perlu membuka Macro dan di kolom kiri, klik dua kali lembar kerja, lalu tempel kode di sebelah kanan. Setiap kali tanggal berubah Sheet1 ini diperbarui pada Sheet2.