Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


9581 / 13646 ツリー ←次へ | 前へ→

【26542】オートフィルター抽出結果を別シートへ 甘いスイカ 05/7/8(金) 12:18 質問[未読]
【26546】Re:オートフィルター抽出結果を別シートへ りん 05/7/8(金) 13:05 発言[未読]
【26559】Re:オートフィルター抽出結果を別シートへ MokoMoko 05/7/9(土) 20:05 回答[未読]
【26562】Re:オートフィルター抽出結果を別シートへ ponpon 05/7/10(日) 9:33 回答[未読]
【26587】Re:オートフィルター抽出結果を別シートへ 甘いスイカ 05/7/11(月) 12:05 お礼[未読]

【26542】オートフィルター抽出結果を別シートへ
質問  甘いスイカ  - 05/7/8(金) 12:18 -

引用なし
パスワード
   VBA初心者です。
お願いします。

シート1に下記のようにデータ(約300件)が入力されています。


A    B    C    D    E   F  
日付  勤務地  氏名  実働  金額   計  
7/1  ○    山田   7h  10,000  7,000
7/2  △    北野   7h  10,000  7,000
7/3  □    山田   7h  10,000  7,000
7/3  ○    森    7h  10,000  7,000


  ↓ これを別シートへ シート名は”氏名”にしたい)

日付  勤務地  氏名  実働  金額   計 
7/1  ○    山田   7h  10,000  7,000
7/3  □    山田   7h  10,000  7,000

今までは、オートフィルターで氏名を抽出して、各シートへ
コピペしていましたが、人数がかなり多くなってきまして大変に
なってきました。
これを VBAで簡単にする方法をお教えください。
説明は上手にできていますか・・・

【26546】Re:オートフィルター抽出結果を別シートへ
発言  りん E-MAIL  - 05/7/8(金) 13:05 -

引用なし
パスワード
   甘いスイカ さん、こんにちわ。

>今までは、オートフィルターで氏名を抽出して、各シートへ
>コピペしていましたが、人数がかなり多くなってきまして大変に
>なってきました。

V3のログですが、参考になりますか?
http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=ntr;tree=7908;id=Excel

【26559】Re:オートフィルター抽出結果を別シートへ
回答  MokoMoko  - 05/7/9(土) 20:05 -

引用なし
パスワード
   ▼甘いスイカ さん:
今晩は、こんな感じでどうでしょうか?
Sub test()
 Dim R As Range
 Dim MyR As Range
 Sheets("抽出").Select '←抽出したい氏名をB2〜B列に並べてください
  Set MyR = Range(Cells(2, 2), Cells(65536, 2).End(xlUp))
  For Each R In MyR
  Sheets("データ").Select '←データを貼り付けてシート作成して下し
    Sheets("データ").Cells.CurrentRegion.AutoFilter 3, R.Value
 Range("B2").CurrentRegion.Select
 Selection.Resize(Selection.Rows.Count - 1).Offset(1).Copy
 Sheets("氏名").Select
 Range("A65536").End(xlUp).Offset(1).Select
 ActiveSheet.Paste
  Next
End Sub


>シート1に下記のようにデータ(約300件)が入力されています。
>A    B    C    D    E   F  
>日付  勤務地  氏名  実働  金額   計  
>7/1  ○    山田   7h  10,000  7,000
>7/2  △    北野   7h  10,000  7,000
>7/3  □    山田   7h  10,000  7,000
>7/3  ○    森    7h  10,000  7,000
>
>
>  ↓ これを別シートへ シート名は”氏名”にしたい)
>
>日付  勤務地  氏名  実働  金額   計 
>7/1  ○    山田   7h  10,000  7,000
>7/3  □    山田   7h  10,000  7,000
>
>今までは、オートフィルターで氏名を抽出して、各シートへ
>コピペしていましたが、人数がかなり多くなってきまして大変に
>なってきました。
>これを VBAで簡単にする方法をお教えください。
>説明は上手にできていますか・・・

【26562】Re:オートフィルター抽出結果を別シートへ
回答  ponpon  - 05/7/10(日) 9:33 -

引用なし
パスワード
   甘いスイカ さん、りんさん、MokoMokoさん
こんばんは。
似たようなことをしていたもんで
こんな感じではいかがでしょう。
違っていたらすみません。

Sub test()
  Dim mySH1 As Worksheet
  Dim mySH As Worksheet
  Dim myR  As Range
  Dim sh As Worksheet
  Dim myVal As Variant
  Dim i As Integer
  
  Application.ScreenUpdating = False

    ' 「シート1」以外のシートの削除
'  For Each sh In ThisWorkbook.Worksheets
'    If Not sh.Name = "シート1" Then
'     Application.DisplayAlerts = False
'     sh.Delete
'     Application.DisplayAlerts = True
'    End If
'  Next
  
  Set mySH1 = Worksheets("シート1")
  Set myR = mySH1.Range("A1").CurrentRegion
    myR.Columns(3).AdvancedFilter xlFilterCopy, _
            copytorange:=mySH1.Range("Z1"), unique:=True
    myVal = mySH1.Range("Z2", mySH1.Range("Z65536").End(xlUp)).Value
  
  For i = 1 To UBound(myVal, 1)
   Set mySH = Worksheets.Add(after:=Sheets(Sheets.Count))
     mySH.Name = myVal(i, 1) & "のデータ"
   With myR
     .AutoFilter field:=3, Criteria1:=myVal(i, 1)
     .Copy mySH.Range("A1")
     .AutoFilter
   End With
  Next i
  mySH1.Range("Z:Z").ClearContents
  Application.ScreenUpdating = True

End Sub

【26587】Re:オートフィルター抽出結果を別シートへ
お礼  甘いスイカ  - 05/7/11(月) 12:05 -

引用なし
パスワード
   みなさん どうも有難うございました。
何とか頑張ってみます!
つまづいた時は、またお願いします。

9581 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free