Excel VBA質問箱 IV

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

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


38883 / 76732 ←次へ | 前へ→

【42976】抽出結果を別シートに保存2
質問  トホホ  - 06/9/28(木) 13:39 -

引用なし
パスワード
   先日こちらで抽出結果を別シートに保存するマクロを
教えていただきました。
それを自分で応用しようと思ったのですが、
なかなか上手くいかないのが実情です。
下の様な抽出条件にさらに抽出条件を追加したいのです。

<現在の内容>フィールド1(A列)を使用してA〜Fのキーでレコードを抽出する。
それぞれキー項目でシートに保存
  抽出 "りんご", 1
  抽出 "なし", 1
  抽出 "みかん", 1
  抽出 "ばなな", 1
  抽出 "メロン", 1
  抽出 "柿", 1
りんご、なし、みかん、ばなな、メロン、柿の6枚のシートが出来上がる。

<変更したい内容>フィールド2(B列)には原産地が入力されているので
りんごだけはさらに原産地ごとに抽出しその結果もシートに保存したい。
"りんご"、"なし"、"みかん"、"ばなな "、"メロン"、"柿"の6枚のシート
プラス"りんご・青森""りんご・山形""りんご・鳥取"というように9枚のシートが
出来上がるようにしたい。
複雑ですが、出来ますでしょうか?


Sub 2.抽結果別シートへ保存()
  抽出 "りんご", 1
  抽出 "なし", 1
  抽出 "みかん", 1
  抽出 "ばなな", 1
  抽出 "メロン", 1
  抽出 "柿", 1
End Sub
'分類=分類を文字列で指定。項目=列番号を数字で指定
Private Sub 抽出(ByVal SYOHINBU As String, ByVal 項目 As Integer)
  Dim Org_Sh As Worksheet '元Sheet
  Dim Des_Sh As Worksheet '先Sheet
  '元SheetをSet
  Set Org_Sh = Worksheets("RE_CALCU")
  '先SheetをSet なければ作成。
  On Error Resume Next
    Set Des_Sh = Worksheets(SYOHINBU)
  On Error GoTo 0
  If Des_Sh Is Nothing Then
    Set Des_Sh = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    Des_Sh.Name = SYOHINBU
  Else
    Des_Sh.Cells.Clear
  End If
  'AutoFilterでコピー
  With Org_Sh.UsedRange
   .AutoFilter Field:=項目, Criteria1:=SYOHINBU
   .SpecialCells(xlVisible).Copy Des_Sh.Range("A1")
   .AutoFilter
  End With
 
  Set Org_Sh = Nothing
  Set Des_Sh = Nothing
End Sub

0 hits

【42976】抽出結果を別シートに保存2 トホホ 06/9/28(木) 13:39 質問
【42980】Re:抽出結果を別シートに保存2 Statis 06/9/28(木) 15:32 回答
【42981】Re:抽出結果を別シートに保存2 ハチ 06/9/28(木) 15:40 回答
【42982】Re:抽出結果を別シートに保存2 トホホ 06/9/28(木) 16:46 質問
【42983】Re:抽出結果を別シートに保存2 ハチ 06/9/28(木) 17:29 発言
【43092】Re:抽出結果を別シートに保存2 トホホ 06/10/2(月) 9:07 お礼
【42984】Re:抽出結果を別シートに保存2 Statis 06/9/28(木) 17:33 回答
【43093】Re:抽出結果を別シートに保存2 トホホ 06/10/2(月) 9:08 お礼

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