下記のように情報が100近くまで存在した場合に、オートフィルターで一つずつ抽出したものをコピーし、新規シートに貼り付けたいのですが、どうすれば良いのでしょうか?
1
1
1
2
2
2
3
3
3
たとえばシート1に
1
1
1
シート2に
2
2
2
といったように処理したいので、教えて下さい。
vbaの参考書とサンプルを見て下記のように作成したのですが上手くいきません。
どんな本を読めば作成出来るようになるのかわからず、質問させていただきました。
ub オートフィルター()
Dim myRng As Range
Dim mySht As Worksheet
Set myRng = _
Worksheets(1).Range("A1").CurrentRegion
With Worksheets
Set mySht = .Add(after:=.Item(.Count))
End With
With myRng
.AutoFilter field:=1, Criteria1:=8
On Error Resume Next
.Resize(.Rows.Count - 1).Offset(1).Copy mySht.Range("A1")
.SpecialCells(xlCellTypeVisible).Copy mySht.Range("A1").AutoFilter
mySht.Range("A1").AutoFilter
If Err.Number <> 0 Then
Application.DisplayAlerts = False
mySht.Delete
Application.DisplayAlerts = True
End If
On Error GoTo 0
End With
Set myRng = Nothing
Set mySht = Nothing
End Sub
A 回答 (3件)
- 最新から表示
- 回答順に表示
No.3
- 回答日時:
ANo2 merlionXXです。
見出し行がある場合のほうの記述に抜けがありました。
修正します。
Sub test01() '見出し行がある場合
Dim ws(1) As Worksheet
Dim myW
Dim i As Long
Set myDic = CreateObject("Scripting.Dictionary")
Set ws(0) = ActiveSheet
Set myRng = ws(0).Range("A1").CurrentRegion
myW = myRng.Columns(1).Value
For i = 1 To UBound(myW)
If Not myDic.Exists(myW(i, 1)) Then
myDic.Add myW(i, 1), ""
End If
Next i
With ws(0)
For i = 2 To myDic.Count
.AutoFilterMode = False
myRng.Rows(1).AutoFilter
myRng.AutoFilter Field:=1, Criteria1:=myDic.keys()(i - 1)
Set ws(1) = Sheets.Add(after:=Sheets(Sheets.Count))
myRng.Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy ws(1).Range("A1")
Next i
End With
End Sub
No.2
- 回答日時:
ご質問に提示されたデータでは見出し行がないようですが、オートフィルターというからには1行目に見出し行がないのが不思議です。
(見出しなしでオートフィルターを設置すると、1行目は常に表示されますので)
単に省略しただけなのでしょうか?
一応、最初のデータに見出し行がある場合と、ない場合の二つの例を書きます。
別シートに転記の際は、ご提示のように見出し行はつけていません。
フィルタをかけるための重複なしのリストの作成には.Dictionaryオブジェクトを利用しました。
ご参考まで。
Sub test01() '見出し行がある場合
Set myDic = CreateObject("Scripting.Dictionary")
Set ws(0) = ActiveSheet
Dim i As Long
Set myRng = ws(0).Range("A1").CurrentRegion
myW = myRng.Columns(1).Value
For i = 1 To UBound(myW)
If Not myDic.Exists(myW(i, 1)) Then
myDic.Add myW(i, 1), ""
End If
Next i
With ws(0)
For i = 2 To myDic.Count
.AutoFilterMode = False
myRng.Rows(1).AutoFilter
myRng.AutoFilter Field:=1, Criteria1:=myDic.keys()(i - 1)
Set ws(1) = Sheets.Add(after:=Sheets(Sheets.Count))
myRng.Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy ws(1).Range("A1")
Next i
End With
End Sub
Sub test02() '見出し行がない場合
Dim ws(1) As Worksheet
Dim myW
Dim myDic As Object
Dim i As Long
Set myDic = CreateObject("Scripting.Dictionary")
Set ws(0) = ActiveSheet
ws(0).Rows("1").Insert Shift:=xlDown
Set myRng = ws(0).Range("A1").CurrentRegion
myW = myRng.Columns(1).Value
For i = 2 To UBound(myW)
If Not myDic.Exists(myW(i, 1)) Then
myDic.Add myW(i, 1), ""
End If
Next i
With ws(0)
For i = 1 To myDic.Count
.AutoFilterMode = False
myRng.Rows(1).AutoFilter
myRng.AutoFilter Field:=1, Criteria1:=myDic.keys()(i - 1)
Set ws(1) = Sheets.Add(after:=Sheets(Sheets.Count))
myRng.Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy ws(1).Range("A1")
Next i
End With
End Sub
No.1
- 回答日時:
フィルタリストを取得しリストをLoopしながらオートフィルタしてみます。
Dim mySht As Worksheet
Dim myRng As Range
Dim fnRng As Range
Dim c As Range
Dim myData() As String '---フィルタリスト
Dim fn As Long '---Field番号
Dim flg As Boolean
Dim i As Long
ReDim myData(0)
fn = 1
Set myRng = Worksheets(1).Range("A1").CurrentRegion
Set fnRng = myRng.Columns(fn).Resize(myRng.Rows.Count - 1).Offset(1)
'リスト
For Each c In Range(fnRng.Address)
If myData(0) = "" Then
myData(0) = c.value
Else
flg = False
For i = 0 To UBound(myData)
If myData(i) = c.value Then
flg = True
Exit For
End If
Next
If Not flg Then
ReDim Preserve myData(UBound(myData) + 1)
myData(UBound(myData)) = c.value
End If
End If
Next
'オートフィルタ
With myRng
For i = 0 To UBound(myData)
With Worksheets
Set mySht = .Add(after:=.Item(.Count))
End With
.AutoFilter Field:=fn, Criteria1:=myData(i)
.Resize(.Rows.Count - 1).Offset(1).Copy mySht.Range("A1")
Next
End With
≪参考≫
リストの取得は、下記掲示板でSALINGERさんのコードを使わせて頂きました。
特定のセル範囲を重複無しで配列に格納する
http://q.hatena.ne.jp/1249216965
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) Sheet1をフィルターで「りんご」を抽出し、Sheet2へ地域を貼り付ける下記マクロを変更して S 2 2022/12/11 03:01
- Visual Basic(VBA) エクセル VBA 処理スピードを上げたいのですが。 6 2023/03/31 20:52
- Visual Basic(VBA) Sheet3から2つの条件でオートフィルターで抽出した個数をSheet2へ入力するマクロで、一つ目の 4 2023/01/12 23:40
- Visual Basic(VBA) 【至急】Excel 同一人物の情報を一行にまとめる(複数行) 6 2022/05/24 17:58
- Visual Basic(VBA) 前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ 7 2023/01/13 22:01
- Visual Basic(VBA) エクセルのマクロで対象ごとにシート分けしてその内容をセルに書き込みたい 9 2022/08/24 13:23
- Visual Basic(VBA) エクセルVBAコピー 2 2022/06/08 21:45
- Visual Basic(VBA) 2つのシートの任意のセルの番号が一致したら、一致した行をコピーする VBA 2 2023/06/19 20:48
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教える店舗&オフィスのセキュリティ対策術
中・小規模の店舗やオフィスのセキュリティセキュリティ対策について、プロにどう対策すべきか 何を注意すべきかを教えていただきました!
-
Excel VBAでオートフィルタで抽出した列データを別シートの最終行にコピーするには
Visual Basic(VBA)
-
VBA オートフィルター繰り返し
Visual Basic(VBA)
-
オートフィルタで抽出したデータを別シートの最終行に追加させたい。
Excel(エクセル)
-
-
4
オートフィルタのリストを順番に印刷できるマクロ
Windows Vista・XP
-
5
エクセルVBA:繰り返し処理について
Access(アクセス)
-
6
【マクロ】オートフィルターのA列のリストを順番に、行数によっては印刷の向きを指定して印刷したい!
Excel(エクセル)
-
7
「オートフィルタ」の作業を自動化したいのですが…
Excel(エクセル)
-
8
エクセルVBAで5行目からオートフィルタモードに設定したいたい
Excel(エクセル)
-
9
エクセルのマクロで結合セルに値を貼り付けたい
Excel(エクセル)
-
10
結合したセルのオートフィルターをVBAで。
Excel(エクセル)
-
11
Excelオートフィルタで複数のセルの値を参照して抽出したい
Excel(エクセル)
-
12
WorkBooksをオープンさせずにシートにコピーしたい【EXCEL VBA】
Excel(エクセル)
-
13
EXCEL VBAで全選択範囲の解除
Excel(エクセル)
-
14
エクセル:マクロ「Application.CutCopyMode = False」って?
Excel(エクセル)
-
15
VBAでの結合セルのコピー&ペースト
Excel(エクセル)
-
16
エクセルVBAでフィルタ抽出部分のみのコピー
Excel(エクセル)
-
17
ExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。
Visual Basic(VBA)
-
18
VBA 連続行データを5行ずつ隣の列に貼り付ける
Excel(エクセル)
-
19
エクセルで、抽出したデータだけを別ファイルにしたい
Excel(エクセル)
-
20
Excelマクロ 空白セルを無視してCSV出力
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルのオートフィルタで最...
-
エクセルでオートフィルタのボ...
-
エクセルで時刻(8:00~20:00)...
-
Excelのオートフィルタで非表示...
-
エクセルの偶数行(奇数行)の抽出
-
なぜShowAllDataだとうまく行か...
-
エクセルで、条件に一致した行...
-
Excel共有ブックのオートフィル...
-
エクセル、オートフィルタで最...
-
エクセル フィルタで抽出したデ...
-
エクセル関数で、数字の入った...
-
オートフィルタで3つ以上の条...
-
Excelで文字を入力と自動的にフ...
-
データの抽出を教えてください
-
(EXCEL)オートフィルタで折りた...
-
Excelマクロ オートフィルタ可...
-
エクセルにて、フィルタをかけ...
-
【Excel】行に複数回出てくる人...
-
Excelマクロ:オートフィルタ3...
-
VBA オートフィルタで抽出した...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで時刻(8:00~20:00)...
-
エクセルのオートフィルタで最...
-
エクセルでオートフィルタのボ...
-
Excelのオートフィルタで非表示...
-
エクセルの偶数行(奇数行)の抽出
-
エクセル関数で、数字の入った...
-
Excel共有ブックのオートフィル...
-
エクセルで、条件に一致した行...
-
エクセル・条件付で行を削除す...
-
access マクロでのフィルタの...
-
オートフィルタで3つ以上の条...
-
オートフィルタで選択したデー...
-
エクセルにて、フィルタをかけ...
-
可視セルを対象としたcountifが...
-
【EXCEL】条件に一致した最新デ...
-
VBA オートフィルタで抽出した...
-
今日の日付のデータをすばやく...
-
【Excel/関数/条件付き書式】月...
-
なぜShowAllDataだとうまく行か...
-
エクセルのオートフィルタで困...
おすすめ情報