プロが教えるわが家の防犯対策術!

オートフィルターでセルの値をCriteriaに入れるマクロを教えて下さい。

A 回答 (3件)

補足です。



#1のマクロを読みきれているのかは分かりませんが、#2の表のようなものを想定して、以下のマクロを作ってみました。すぐに出来ると思いましたが、なかなかそうはいきませんでした。

Sub TestMacro1()
  Dim iSh As Worksheet
  Dim kSh As Worksheet
  Dim myData As Range
  Dim c As Variant
  Dim i As Long
  Dim j As Long
  Set iSh = Worksheets("一覧表")
  Set kSh = Worksheets("記入用")
  Application.ScreenUpdating = False
  
  With iSh
  '検索用のデータの抽出
  If .AutoFilterMode = True Then .AutoFilterMode = False
    With .Range("G1", .Range("G65536").End(xlUp))
      .AdvancedFilter _
      Action:=xlFilterCopy, _
      CopyToRange:=.Range("AZ1"), _
      Unique:=True
    End With
    Set myData = .Range("AA2", .Range("AA65536").End(xlUp))
    'オートフィルタで抽出
    For Each c In myData
      .Range("D1", .Range("G65536").End(xlUp)).AutoFilter _
      Field:=4, _
      Criteria1:=c.Value
      With .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
      '抽出行の最後の行+1
        j = .Cells(65536, 1).End(xlUp).Row + 1
      End With
      .Rows(j).Insert
      
      '記入用のシートからコピーする列は、Resize(, 7) は、7列という意味
      kSh.Range("A13").Resize(, 7).Copy .Cells(j, 1)
    Next c
    .AutoFilterMode = False
    '検索用のデータの削除
    .Range("AZ1").CurrentRegion.ClearContents
  End With
  Application.ScreenUpdating = True
  Set myData = Nothing
  Set iSh = Nothing
  Set kSh = Nothing
End Sub
    • good
    • 0

こんにちは。



ご自身で考えられたのですね。私は、すぐに理解できませんでしたが、コードの書き方とかは別として、独特のアイデアで、それは非凡な発想だと思います。ここの掲示板では、そのコードで理解できる人ばかりではありませんが、そのコードなら、分かる人は、必ず評価してくれるはずです。やはり、最初にコードを書くべきだったと思います。

行を挿入して、そこに合計などを入れるのでしょうか。
今、別の方法を考えてみたのですが、パッと思いつきません。

通常は、以下のようになっていて、下にSelect を下げていく方法で、上と下の Cells(i,7).Value <>Cells(i+1,7).Value [7は、G列] というような方法をとりますが、特に、何千行という場合には、それは、いわゆる、ぬるいコードというしかありません。かといって、なかなかSort を使おうという発想にはなりません。Sort を使う真価は、大量の行がある時です。3万行程度でも、まったく、待たされることがなく、選び出します。

ここの質問は、最初だと思いますが、もう数回、頑張ってみるつもりがあるなら、私もお付き合いいたします。あまり、くだらないことを書くつもりはありませんが、もう少し、テクニック的なものが必要ですね。

こんなスタイルになるのでしょうか?

部署
--------
営業1課
営業1課
営業1課
営業1課
営業1課
営業2課 <- 一行、挿入して、ペースト
営業2課
営業2課
営業2課
    • good
    • 0

こんばんは。



例えば、こんな風に書きます。
なお、マクロのご質問では、なるべくコードを出したほうが回答が付きやすいです。
そうしないと、製作依頼のように思われて、敬遠されてしまいます。


Sub Test1()
  Dim myCrite As String
  myCrite = Range("F1").Value
  
  If myCrite <> "" Then
    Range("A1").CurrentRegion.AutoFilter _
    Field:=1, _
    Criteria1:=myCrite, _
    Operator:=xlOr, _
    Criteria2:="="
  End If
End Sub
  
    • good
    • 0
この回答へのお礼

お礼遅くなって申し訳ございません。解決いたしました。
どうもありがとうございました。
質問は、記入用から一覧表の部署毎の一番下に挿入できるようにマクロを組みましたがまだマクロ初心者で部署毎にマクロを作ったので一つにしようと
"Criteria1:="後に関数とか入れてみましたがだめだったので質問しました。コードは長いので以下一部をだします。
Sub 記入()
Sheets("一覧表").Select
Columns("D:G").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="営業"
Range("G1").Select
Range(Selection, Selection.End(xlDown)).Select
Dim x1 As Integer, y1 As Integer
Dim z1 As Long
y1 = Range("A:A").Column
z1 = Range("G1").End(xlDown).Row
With ActiveSheet
For x1 = 1 To y1
Range(Cells(z1 + 1, x1), Cells(z1 + 1, x1)).Select
Selection.EntireRow.Insert
Sheets("記入用").Select
Range("A13").Select
Selection.Copy
Sheets("一覧表").Select
ActiveCell.Select
Selection.PasteSpecial Paste:=xlValues
Next x1
End With
Dim x2 As Integer, y2 As Integer
Dim z2 As Long
y2 = Range("B:B").Column
z2 = Range("G1").End(xlDown).Row
With ActiveSheet
For x2 = 2 To y2
Range(Cells(z2 + 1, x2), Cells(z2 + 1, x2)).Select
Sheets("記入用").Select
Range("B13").Select
Selection.Copy
Sheets("一覧表").Select
ActiveCell.Select
ActiveSheet.Paste
Selection.Font.ColorIndex = 0
Next x2
End With

お礼日時:2008/05/01 07:29

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!