1つのブックに1ヶ月の日数分のシートがあります。(約30シート)
それぞれのシートのデータは、
1水(sheet名)
A B… P Q R S
1 りんご 4つ 300円
2 みかん 3つ 500円
3 りんご 5つ 400円
4 バナナ 1つ 100円
… … … …
2木(sheet名)
A B… P Q R S
1 ぶどう 4つ 300円
2 みかん 3つ 500円
3 りんご 2つ 200円
4 バナナ 1つ 100円
… … … …
の様なデータが入力されています。
それぞれ複数のシートのデータの中から、りんごだけを集め集計用のシートに以下の様に表示したいです。
集計用sheet
A B C D
1 1水 りんご 4つ 300円
2 1水 りんご 5つ 400円
3 2木 りんご 2つ 200円
4
… … … …
関数でもVBAでもいいので、複数のシートから抽出することは可能でしょうか?
どなたかわかるかた教えて下さい。
よろしくお願いします。
No.7ベストアンサー
- 回答日時:
今度こそ..大丈夫だと思います。
集計用シート名、検索範囲、結果表示の左上角、検索文字列を編集できます。
例えば、検索文字列に「ぶどう」を追加する場合はこのようになります。
If s(i, 1) = "りんご" Or s(i, 1) = "ぶどう" Then '検索文字列
ここだけは注意して下さい。
Sub りんご抽出コード()
Dim i, j, k, l, m, n, o, y, z, r, t As Long
Dim s, A, B, sn, x As Variant
Dim shn1, shrange As String
Dim p, q As Byte
shn1 = "集計用sheet" '集計用シート名
shrange = "P1:S65536" '検索範囲(全て半角)
wrrange = "B4" '結果表示の左上角
x = Split(shrange, ":") '検索範囲を分割
For q = 0 To 1
For p = 1 To Len(x(q))
If IsNumeric(Mid$(x(q), p, 1)) = False Then
If q = 1 Then y = Mid$(x(0), p + 1) Else: z = Mid$(x(1), p + 1)
End If
Next p
Next q
k = Range(shrange).Columns.Count
ReDim B(Worksheets.Count) 'シート名を取得
For Each sn In Worksheets
i = i + 1: B(i) = sn.Name
Next sn
ReDim A(z - y + 1, k + 1) 'りんごの行を配列に格納
For m = 1 To Worksheets.Count - 1
If B(m) = shn1 Then GoTo 1
s = Sheets(B(m)).Range(shrange)
For i = 1 To z - y + 1
If s(i, 1) = "りんご" Then '検索文字列
j = j + 1: A(j, 1) = B(m)
For l = 1 To k
A(j, l + 1) = s(i, l)
Next l
End If
Next i
1
Next m
With Range(wrrange)
r = .Row - 1: t = .Column - 1
End With
For o = 1 To k + 1 'セルに書き込み
For n = 1 To z - y + 1
If A(n, 1) = "" Then Exit For
Sheets(shn1).Cells(n + r, o + t) = A(n, o)
Next n
Next o
End Sub
No.6
- 回答日時:
回答番号:No.2 です。
「りんご」があるのはP列でいいんですよね?
それなら以下でもう一度お試しください。
P列でないならそう言ってください。
Sub test02()
Dim st As Worksheet
Dim r As Long, x As Long
For Each st In Worksheets
If st.Name <> "集計用" Then
st.Activate
With ActiveSheet
.AutoFilterMode = False
.Rows("1:1").Insert Shift:=xlDown
.Range("A1:S1").AutoFilter
.Range("A1:S1").AutoFilter Field:=16, Criteria1:="りんご"
r = .Cells(Rows.Count, "P").End(xlUp).Row
On Error Resume Next
.Range(.Cells(2, "P"), .Cells(r, "S")).SpecialCells(xlCellTypeVisible).Copy
On Error GoTo 0
x = Sheets("集計用").Cells(Rows.Count, "B").End(xlUp).Row
If x > 1 Then x = x + 1
Sheets("集計用").Cells(x, "A").Value = ActiveSheet.Name
Sheets("集計用").Cells(x, "B").PasteSpecial
Application.CutCopyMode = False
.AutoFilterMode = False
.Rows("1:1").Delete
End With
End If
Next
Sheets("集計用").Activate
End Sub
No.5
- 回答日時:
#1です。
>しかし、他検索の拡張性はあった方がいいです。
INPUTBOX等で値の取得をして下さい。
あと1行目に項目行はないのかな?
⇒あればAutoFilter等使えそうなんですけど。
それとデータ範囲(列)がわかりにくいのですが。。。
No.4
- 回答日時:
No.3の回答者です。
おかしなところがあったので、修正しました。Sub りんご抽出コード()
Dim i, j, k, l, m, n, o As Long
Dim S, A, B, sn As Variant
ReDim B(Worksheets.Count)
For Each sn In Worksheets
i = i + 1
B(i) = sn.Name
Next sn
k = 3
ReDim A(65536, k)
For m = 1 To Worksheets.Count
If B(m) = "集計" Then GoTo 1
S = Sheets(B(m)).Range("B1:D65536")
For i = 1 To 65536
If S(i, 1) = "りんご" Then
j = j + 1
A(j, 1) = B(m)
For l = 2 To k
A(j, l) = S(i, l)
Next l
End If
Next i
1
Next m
For o = 1 To k + 1
For n = 1 To 65536
If A(n, 1) = "" Then Exit For
With Sheets("集計")
Select Case o
Case 1
.Cells(n, 1) = A(n, 1)
Case 2
.Cells(n, 2) = "りんご"
Case Else
.Cells(n, o) = A(n, o - 1)
End Select
End With
Next n
Next o
End Sub
この回答への補足
回答2例ありがとうございます!
上記を試したのですが機能しません…。
実行すると、砂時計マークは表示ているので、計算はしているみたいなのですが、計算結果がなにも表示されません。
なにか問題があるのでしょうか?
下記の方がほぼ完璧に動作しました。
計算スピードも実用性があり、大変満足です。
しかし、もう少し質問があります。
表示用シートに
(1)他シートのPからRでなく、PからSまでを検索したい
(2)検索結果の表示をA1からでなくB4から表示したい
すみませんが宜しくお願いします。
No.3
- 回答日時:
独学なのでおかしなところがあるかもしれませんが、動作確認はしました。
Sub りんご抽出コード()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, _
S As Variant, A As Variant, B As Variant, sn As Worksheet
ReDim B(Worksheets.Count)
For Each sn In Worksheets
i = i + 1
B(i) = sn.Name
Next sn
k = 3 'PからRなので3です。
ReDim A(65536, k)
For m = 1 To Worksheets.Count
S = Sheets(B(m)).Range("P1:R65536")
For i = 1 To 65536
If S(i, 1) = "りんご" Then
j = j + 1
A(j, 1) = B(m)
For l = 2 To k
A(j, l) = S(i, l)
Next l
End If
Next i
Next m
For o = 1 To k
For n = 1 To 65536
If A(n, o) = "" Then Exit For
Sheets("集計").Cells(n, o) = A(n, o)
Next n
Next o
End Sub
No.2
- 回答日時:
Sub test01()
Dim st As Worksheet
For Each st In Worksheets
If st.Name <> "集計用" Then
st.Activate
With ActiveSheet
.AutoFilterMode = False
.Rows("1:1").Insert Shift:=xlDown
.Range(.Range("A2"), .Range("A2").End(xlToRight)).Offset(-1).AutoFilter
.Range(.Range("A2"), .Range("A2").End(xlToRight)).AutoFilter Field:=16, Criteria1:="りんご"
On Error Resume Next
.Range(.Range(.Range("P2"), .Range("P2").End(xlDown)), .Range(.Range("P2"), .Range("P2").End(xlDown)).End(xlToRight)).SpecialCells(xlCellTypeVisible).Copy
On Error GoTo 0
x = Sheets("集計用").Cells(Rows.Count, "B").End(xlUp).Row
If x > 1 Then x = x + 1
Sheets("集計用").Cells(x, "A").Value = ActiveSheet.Name
Sheets("集計用").Cells(x, "B").PasteSpecial
Application.CutCopyMode = False
.AutoFilterMode = False
.Rows("1:1").Delete
End With
End If
Next
Sheets("集計用").Activate
End Sub
この回答への補足
回答ありがとうございます。
しかし、
Range(.Range("A2"), .Range("A2").End(xlToRight)).AutoFilter Field:=16, Criteria1:="りんご"
のところでエラーになってしまいます。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Microsoft Formsによるアンケー...
-
ピボットテーブルのことです
-
勤務表の中抜け集計の関数を教...
-
IF関数を使用した数字に、カン...
-
エクセルのピポットテーブルで...
-
オートシェイプを色別に個数を...
-
エクセルの集計機能を横方向(...
-
エクセル 小計後に別シートにデ...
-
エクセルの最大行数を超えるデータ
-
エクセルの集計を数字以外です...
-
ピボットテーブルの集計値をVBA...
-
エクセル ピボットテーブルを更...
-
Accessで日付のみのデータから...
-
価格帯別集計 EXCELで効率の良...
-
Excelの集計について
-
エクセルで工事台帳を作ってい...
-
エクセルで○や×の図形の集計は...
-
エクセルにある決められた領域...
-
Excelの小計機能をVBAでやりた...
-
マクロで貼り付け位置を可変さ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ピボットテーブルのことです
-
マクロで貼り付け位置を可変さ...
-
エクセルのピポットテーブルで...
-
エクセルで○や×の図形の集計は...
-
Microsoft Formsによるアンケー...
-
IF関数を使用した数字に、カン...
-
エクセルの集計を数字以外です...
-
保存ブックを開かずコピーペー...
-
オートシェイプを色別に個数を...
-
勤務表の中抜け集計の関数を教...
-
エクセルの集計機能を横方向(...
-
ピボットテーブルの項目間の計算
-
ピボットテーブルへの集計フィ...
-
エクセル 小計後に別シートにデ...
-
Excel週ごとの集計を関数で
-
エクセルのフッターについて
-
エクセル ピボットテーブルを更...
-
エクセルで数値のプラス毎とマ...
-
アクセスのFormat関数に...
-
セルの中の文字を削除したい
おすすめ情報