Riportare commenti settimanali in report

[BG66]

Ciao a tutti,
vorrei riportare, tenendo conto delle data impostate, i commenti presenti nel foglio DB_17 in una scheda riassuntiva che il VBA dovrebbe generare nel foglio Report dal range C3:D3 in giù.

Come inizio ho provato ad importare almeno un commento a prescidere dalle date ma non ci sono riuscito:

Codice: Seleziona tutto

Sub Reportcommenti()
 Dim aCell As Range
 Dim n As String
 Dim oCmt As Comment
 Dim ws As Workbook
 
 Set sh1 = Worksheets("DB_17")
 Set sh2 = Worksheets("Report")
 Set aCell = sh1.Range("A4")
 Set oCmt = aCell.Comment
    If oCmt Is Nothing Then
 Else
    n = oCmt.Text
    sh2.Range("E4").Value = n
    End If
Set sh1 = Nothing
Set sh2 = Nothing
End Sub


Grazie per l'aiuto.
https://www.dropbox.com/s/nanh0wb6ibir2c0/Cuc_form_finale%20_FORUM.xlsm?dl=0

[Anthony47]

Prova con questa "variante":

Codice: Seleziona tutto

Sub Reportcommenti1()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim myC As Comment
'
Set sh1 = Worksheets("DB_17")
Set sh2 = Worksheets("Report")
For Each myC In sh1.Comments
    mynext = sh2.Cells(Rows.Count, "C").End(xlUp).Row + 1
    sh2.Cells(mynext, 3) = sh1.Cells(myC.Parent.Row, "B")
    sh2.Cells(mynext, 4) = sh1.Cells(2, myC.Parent.Column)
    sh2.Cells(mynext, 5) = myC.Text
Next myC
MsgBox ("Completato...")
End Sub

Ciao

[BG66]

Ciao Anthony,
ho provato ad integrarla per fare questo:

Ciao a tutti,
vorrei riportare, tenendo conto delle data impostate, i commenti presenti nel foglio DB_17 in una scheda riassuntiva che il VBA dovrebbe generare nel foglio Report dal range C3:D3 in giù.

e quindi cancello il range precedentemente scritto (in realtà gli ho definito un range specifico -> sò farlo solo cosi )e poi gli chiedo di tenere conto delle date presenti in Reporto in A6 e A9 ma NON funziona:

Codice: Seleziona tutto

Sub Reportcommenti1()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim myC As Comment
Dim SourceRange As Range, TargetRange As Range
Dim DataIni As Date, DataFin As Date, i
'
Set sh1 = Worksheets("DB_17")
Set sh2 = Worksheets("Report")
Set SourceRange = sh1.Range("B3:Z368")
'
Sheets("Report").Select
    Range("C3:E15").Select
    Selection.ClearContents

DataIni = sh2.Range("A6")
DataFin = sh2.Range("A9")
    If Not IsEmpty(SourceRange(2, 1)) Then
Set SourceRange = SourceRange.Resize _
(SourceRange.End(xlDown).Row - SourceRange.Row + 1)
    End If
        For Each i In SourceRange
    If DataIni <= i.Offset(, 1) And i.Offset(, 1) <= DataFin Then
'For Each myC In sh1.Comments
    mynext = sh2.Cells(Rows.Count, "C").End(xlUp).Row + 1
    sh2.Cells(mynext, 3) = sh1.Cells(myC.Parent.Row, "B")
    sh2.Cells(mynext, 4) = sh1.Cells(2, myC.Parent.Column)
    sh2.Cells(mynext, 5) = myC.Text
   
    End If
Next
'Next myC
MsgBox ("Completato...")

End Sub

Grazie per l'aiuto

[Anthony47]

Qualche parola in piu' per descrivere non fa mai male.
Quindi vorresti tenere conto "delle data impostate nelle celle A6 e A9 di Report", azzerando l'elenco prima di cominciare...

Prova questa variante:

Codice: Seleziona tutto

Sub Reportcommenti11()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim myC As Comment
'
Set sh1 = Worksheets("DB_17")
Set sh2 = Worksheets("Report")
sh2.Range("C3:E1000").ClearContents
For Each myC In sh1.Comments
    If sh1.Cells(myC.Parent.Row, "B") >= sh2.Range("A6") And sh1.Cells(myC.Parent.Row, "B") <= sh2.Range("A9") Then
        mynext = sh2.Cells(Rows.Count, "C").End(xlUp).Row + 1
        sh2.Cells(mynext, 3) = sh1.Cells(myC.Parent.Row, "B")
        sh2.Cells(mynext, 4) = sh1.Cells(2, myC.Parent.Column)
        sh2.Cells(mynext, 5) = Replace(myC.Text, Chr(10), " ", , , vbBinaryCompare)
    End If
Next myC
MsgBox ("Completato...")
End Sub

Le altre modifiche che hai apportato non ho capito da cosa sono motivate.
Se avessimo la garanzia che le date in DB_17 saranno sempre "crescenti" si potrebbe fare qualche ottimizzazione in velocita'.

Ciao

[BG66]

Ciao Anthony,
è ovviamente OK.
L'impostazione del foglio DB_17 resterà quella che vedi tranne se l'anno è bisestile...