1

毎月新しいオブジェクトを登録するために使用する、年間を通じて日付を含むカレンダーを作成しました。月自体は重要ではありません - 正しい日付範囲を見つけるための参照として月を使用しているだけなので、現時点では見えます。

FEB  01/02/2014
FEB  02/02/2014 
FEB  03/02/2014
FEB  04/02/2014
FEB  05/02/2014
MAR  01/03/2014
MAR  02/03/2014
JUN  02/06/2014
Jun  03/06/2014

一年中整っています。最初のページに月の詳細を示すドロップダウン メニューがあります。選択した月を参照として使用し、その月に関連付けられたすべての日付を別の列にコピーするマクロが必要です。

何か案は？

4

1 に答える 1

0

次のコードは近いはずです - 必要に応じて調整してください。これは効率のために書かれたものではありません。何千ものアイテムをコピーする場合を除き、これには「まったく時間がかかりません」。このApplication.ScreenUpdatingトリックは、更新中に画面がちらつくのを防ぎます (そして、速くします)。

Option Compare Text

Sub moveStuff()
Dim rLabel As Range
Dim rLabelSource As Range

Dim rDestination As Range
Dim c, L

' first label:
Set rLabel = ActiveWorkbook.Worksheets("source").Range("A2")
' extend all the way down:
Set rLabel = Range(rLabel, rLabel.End(xlDown))

Set rLabelSource = ActiveWorkbook.Worksheets("destination").Range("A1")
Set rLabelSource = Range(rLabelSource, rLabelSource.End(xlToRight))

Application.ScreenUpdating = false

' labels in the top row:
For Each L In rLabelSource.Cells
' write results in the next row down:
  Set rDestination = L.Offset(1, 0)
  For Each c In rLabel.Cells
    If c.Value = L.Value Then
      rDestination.Value = c.Offset(0, 1).Value
      Set rDestination = rDestination.Offset(1, 0)
    End If
  Next c
Next L

Application.ScreenUpdating = true

End Sub

この場合、日付とラベルは「ソース」というシートにあります。

ここに画像の説明を入力

そして、「宛先」と呼ばれるシートの宛先シート（一番上の行にラベルがあり、その下にコピーされた日付が表示されます）：

ここに画像の説明を入力

明らかに、これをきれいにする方法はたくさんあります (destinationたとえば、コピーする前にラベルの下のすべてのスペースをクリアして、古い値が残らないようにします)。そして、「実際の」コードでは、エラー処理などを追加します.

ただし、これでうまくいくはずです。

于 2013-11-14T19:35:45.260 に答える