誰か助けてくれませんか。
「ソース」「AllData」シートからデータを抽出し、この情報を「宛先」「直接活動」シートに貼り付けるために、使用したい次のコードをまとめました。
もう少し詳しく言うと：
- スクリプトで「送信先」シートの列Eにあるテキスト値「DIR」を検索するようにしたいと思います。
- これが見つかったら、列DとBから値をコピーし、両方に対して一意の個別のリストを作成します。
- 「Destination」シートの列Dから列Bに、列Bから列Cに値を貼り付けます。
さらに、スクリプトで、[ソース] シートの列Iのマンデイの数値をすべて合計し、[目的地] シートの関連する月の下に配置したいと考えています。
Sub Extract()
Dim i As Long, j As Long, m As Long, strProject As String, RLOB As String, RDate As Date, RVal As Single
Dim BlnProjExists As Boolean, ws As Worksheet, DI As Worksheet, LastRow As Long
Const StartRow As Long = 5
Application.ScreenUpdating = False
Set DI = Sheets("Direct Activities")
With Sheets("AllData").Range("E3")
For i = 1 To .CurrentRegion.Rows.Count - 1
strProject = .Offset(i, 0)
RDate = .Offset(i, 3)
RVal = .Offset(i, 4)
RLOB = .Offset(i, -3)
If InStr(.Offset(i, 0), "DIR") > 0 And RVal > 0 Then
strProject = .Offset(i, -1)
RLOB = .Offset(i, -3)
With DI.Range("B1")
If .CurrentRegion.Rows.Count = 1 Then
.Offset(1, 0) = strProject
j = 1
Else
BlnProjExists = False
For j = 1 To .CurrentRegion.Rows.Count - 1
If .Offset(j, 0) = strProject And .Offset(j, 1) = RLOB Then
BlnProjExists = True
Exit For
End If
Next j
If BlnProjExists = False Then
.Offset(j, 0) = strProject
End If
End If
Select Case Format(RDate, "mmm yy")
Case "Apr 13"
m = 1
Case "May 13"
m = 2
Case "Jun 13"
m = 3
Case "Jul 13"
m = 4
Case "Aug 13"
m = 5
Case "Sep 13"
m = 6
Case "Oct 13"
m = 7
Case "Nov 13"
m = 8
Case "Dec 13"
m = 9
Case "Jan 14"
m = 10
Case "Feb 14"
m = 11
Case "Mar 14"
m = 12
End Select
m = m + 1
.Offset(j, m) = .Offset(j, m) + RVal
End With
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
「Destination」シートの列Bの値を貼り付けることはできますが、値が誤って複数回繰り返され、「Source」シートの列Bから列Cに値をコピーできませんでした。 「宛先」シート。
ただし、「ソース」シートの列 I から「目的地」シートの正しい月までのマンデイの数字を合計することはできます。
「ソース」「AllData」シートと「直接活動」「宛先」シートを含むファイルをここにアップロードしました。「マクロ」シートのボタンを選択すると、マクロを実行できます。
さらに、マクロで達成したいことを示す別のシート「期待されるアクティビティ」を含めました。
誰かがこれを見て、どうすればこれを達成できるかについてのガイダンスを提供できるかどうか疑問に思いました.
多くの感謝と親切な敬意