2008-09-17 13 views
3

マクロまたは条件付きでExcel 2003でワークシートの行を別のワークシートにコピーする方法はありますか?条件付きで行を別のワークシートにコピーするマクロはありますか?

Webクエリを介してSharePointからデータのリストをExcelの空のワークシートにプルしてから、特定の月の行を特定のワークシートにコピーしたいとします(たとえば、 7月のワークシートへのSharePointワークシート、6月のワークシートへのSharePointワークシートからの6月のデータなど)。

サンプル・データ

Date - Project - ID - Engineer 
8/2/08 - XYZ - T0908-5555 - JS 
9/4/08 - ABC - T0908-6666 - DF 
9/5/08 - ZZZ - T0908-7777 - TS 

それは一回限りの練習ではありません。私は上司がSharePointから最新のデータを引き出し、毎月の結果を見ることができるダッシュボードをまとめようとしているので、常にそれを行い、きれいに整理する必要があります。

答えて

0

これは単なる練習問題ですが、より簡単な方法として、ソースデータにフィルタを適用し、フィルタ処理した行をコピーして新しいワークシートに貼り付けることができますか?

1

これは部分的に擬似コードですが、あなたのようなものになるでしょう。それがセットアップされた方法は、私はすぐにペインからそれを呼んだが、あなたは簡単に(サブを作成することができます。これは動作します

rows = ActiveSheet.UsedRange.Rows 
n = 0 

while n <= rows 
    if ActiveSheet.Rows(n).Cells(DateColumnOrdinal).Value > '8/1/08' AND < '8/30/08' then 
    ActiveSheet.Rows(n).CopyTo(DestinationSheet) 
    endif 
    n = n + 1 
wend 
5

を)、月ごとにMoveDataを1回呼び出すと、サブデータが呼び出されます。

あなたはそれがすべて

Public Sub MoveData(MonthNumber As Integer, SheetName As String) 

Dim sharePoint As Worksheet 
Dim Month As Worksheet 
Dim spRange As Range 
Dim cell As Range 

Set sharePoint = Sheets("Sharepoint") 
Set Month = Sheets(SheetName) 
Set spRange = sharePoint.Range("A2") 
Set spRange = sharePoint.Range("A2:" & spRange.End(xlDown).Address) 
For Each cell In spRange 
    If Format(cell.Value, "MM") = MonthNumber Then 
     copyRowTo sharePoint.Range(cell.Row & ":" & cell.Row), Month 
    End If 
Next cell 

End Sub 

Sub copyRowTo(rng As Range, ws As Worksheet) 
    Dim newRange As Range 
    Set newRange = ws.Range("A1") 
    If newRange.Offset(1).Value <> "" Then 
     Set newRange = newRange.End(xlDown).Offset(1) 
     Else 
     Set newRange = newRange.Offset(1) 
    End If 
    rng.Copy 
    newRange.PasteSpecial (xlPasteAll) 
End Sub 
1

をコピーされています後、あなたの月次データをソートするロジックを追加することもここでは比較のために、アレイ内のVBAの日付関数と店で構築されたすべての日付データの一部を使用する別の解決策です

Public Sub MoveData(MonthNum As Integer, FromSheet As Worksheet, ToSheet As Worksheet) 
    Const DateCol = "A" 'column where dates are store 
    Const DestCol = "A" 'destination column where dates are stored. We use this column to find the last populated row in ToSheet 
    Const FirstRow = 2 'first row where date data is stored 
    'Copy range of values to Dates array 
    Dates = FromSheet.Range(DateCol & CStr(FirstRow) & ":" & DateCol & CStr(FromSheet.Range(DateCol & CStr(FromSheet.Rows.Count)).End(xlUp).Row)).Value 
    Dim i As Integer 
    For i = LBound(Dates) To UBound(Dates) 
     If IsDate(Dates(i, 1)) Then 
      If Month(CDate(Dates(i, 1))) = MonthNum Then 
       Dim CurrRow As Long 
       'get the current row number in the worksheet 
       CurrRow = FirstRow + i - 1 
       Dim DestRow As Long 
       'get the destination row 
       DestRow = ToSheet.Range(DestCol & CStr(ToSheet.Rows.Count)).End(xlUp).Row + 1 
       'copy row CurrRow in FromSheet to row DestRow in ToSheet 
       FromSheet.Range(CStr(CurrRow) & ":" & CStr(CurrRow)).Copy ToSheet.Range(DestCol & CStr(DestRow)) 
      End If 
     End If 
    Next i 
End Sub 
0

私はこれを手動で行うような方法がある:

    あなたが大量のデータを取得する場合、より優れた性能を与えることがあります
  • 使用するデータ - オートフィルタ
  • 日付範囲に基づいて、カスタムフィルタを適用します
  • コピーフィルタリングされたデータ関連の月シートへ
  • を繰り返し、毎月のために、以下の上場

は、このプロセスを行うためのコードですVBAを介して。

個々の行ではなく、月単位のデータセクションを処理する利点があります。より大きなデータセットに対してより迅速に処理することができます。

Sub SeperateData() 

    Dim vMonthText As Variant 
    Dim ExcelLastCell As Range 
    Dim intMonth As Integer 

    vMonthText = Array("January", "February", "March", "April", "May", _ 
"June", "July", "August", "September", "October", "November", "December") 

     ThisWorkbook.Worksheets("Sharepoint").Select 
     Range("A1").Select 

    RowCount = ThisWorkbook.Worksheets("Sharepoint").UsedRange.Rows.Count 
'Forces excel to determine the last cell, Usually only done on save 
    Set ExcelLastCell = ThisWorkbook.Worksheets("Sharepoint"). _ 
    Cells.SpecialCells(xlLastCell) 
'Determines the last cell with data in it 


     Selection.EntireColumn.Insert 
     Range("A1").FormulaR1C1 = "Month No." 
     Range("A2").FormulaR1C1 = "=MONTH(RC[1])" 
     Range("A2").Select 
     Selection.Copy 
     Range("A3:A" & ExcelLastCell.Row).Select 
     ActiveSheet.Paste 
     Application.CutCopyMode = False 
     Calculate 
    'Insert a helper column to determine the month number for the date 

     For intMonth = 1 To 12 
      Range("A1").CurrentRegion.Select 
      Selection.AutoFilter Field:=1, Criteria1:="" & intMonth 
      Selection.Copy 
      ThisWorkbook.Worksheets("" & vMonthText(intMonth - 1)).Select 
      Range("A1").Select 
      ActiveSheet.Paste 
      Columns("A:A").Delete Shift:=xlToLeft 
      Cells.Select 
      Cells.EntireColumn.AutoFit 
      Range("A1").Select 
      ThisWorkbook.Worksheets("Sharepoint").Select 
      Range("A1").Select 
      Application.CutCopyMode = False 
     Next intMonth 
    'Filter the data to a particular month 
    'Convert the month number to text 
    'Copy the filtered data to the month sheet 
    'Delete the helper column 
    'Repeat for each month 

     Selection.AutoFilter 
     Columns("A:A").Delete Shift:=xlToLeft 
'Get rid of the auto-filter and delete the helper column 

    End Sub 
関連する問題