質問:特定文字列から空白行までの抽出
お世話になります、ネットで公開されているVBAを修正して何とかなっているVBA初級者です。
毎月excelで出力されたファイルを元に関数で整形したと思っていますが、”北棟2”の開始
するセル位置は解っているのでそれを基準に利用するのは簡単ですが、7777村上まで(空
白があるまで)を抜き出して"sheet_work"もしくは"北棟2"とういうsheetのB8セルに貼り
付けたいと考えています。
北棟2だけではなく、空白に挟まれた行は毎月変動するために関数でのセル指定が役に立ちま
せん。この場合、北棟2、南棟1、西棟2、東棟1、東棟3といた文字列の次の行のA,B,C列
から空白が発生する行までを整形しやすいsheetか文字列通りのsheet名のB8セルに貼り付ける
方法が御座いましたらご教授お願いいたします。関数だけで力業で可能でしたらそちらもお教
えお願いします。
以下が出力されますが、空白から空白までは一定では無く、増減します。
小計の行は不要です。
A B C
5 xxxxxx名 日付
6
7 北棟2
8 1111鈴木 5
9 2222武田 5
10 11200山田 5
11 4444高橋 4
12 5555佐藤 5
13 6666小林 4
14 7777村上 0
15
16 小計 28
17
18 南棟1
19 1001中村 4
20 1002伊藤 5
21 1003吉田 4
22 20110佐々木 5
23 1005木村 3
24 1006渡辺 0
25 1007田中 4
26
27 小計 25
28
29 西棟2
30 10020森 2
31 2010岡田 1
32 2033池田 0
33 2058井上 5
34
35 小計 8
36
37 東棟1
38 7854石田 4
45 東棟3
46 4471石岡 2
No.6ベストアンサー
- 回答日時:
Sheet1のコードとしてください
Sub test()
Dim m_Start As Object
Dim m_Tou As Variant
Dim Check As Boolean
Dim EndAddress As String
Dim i As Integer, j As Integer
m_Tou = Array("北棟2", "南棟1", "西棟2", "東棟1", "東棟3")
For i = 0 To UBound(m_Tou)
Set m_Start = Range("B:B").Find(what:="*" & m_Tou(i) & "*")
Check = True
j = 1
Do
If Range("B" & m_Start.Row + j).Value = "" Then
Check = False
EndAddress = Range("B" & m_Start.Row + j - 1).Offset(0, 1).Address
End If
j = j + 1
Loop Until Check = False
Range(m_Start.Offset(1, -1).Address & ":" & EndAddress).Copy
Sheets(m_Tou(i) & "H").Range("B8").PasteSpecial
Next
Application.CutCopyMode = False
End Sub
ありがとう御座いました。こんなに早く目的が達成できるとは思っておりませんでした。
完璧です。
Find(what:="*" & m_Tou(i) & "*") の"*"や所々解らない部分もありますが、助かりました
ありがとう御座います。
No.5
- 回答日時:
#2です。
>(手動で”北棟2”の範囲を”北棟2H”のシートのB8以下へ貼り付けしました)、
セルの"北棟2"がシート名"北棟2H"なら、
rr.Copy Worksheets(r.Item(1).Offset(, 1).Value & "H").Range("B8")
となります。
⇒アップされたファイルは観られないみたい?
お手数かけました、ジオシティーズは制限が多かったようです。ご迷惑をおかけしました。
もう一度ファイルをアップしました。
https://www.webfile.jp/dl.php?i=730597&s=b7eac4e …
よろしくお願いいたします。
No.4
- 回答日時:
ANo3 修正です
EndAddress = Range("A" & m_Start.Row + j - 1).Address
↓
EndAddress = Range("A" & m_Start.Row + j - 1).Offset(0, 1).Address
この回答への補足
ありがとう御座います。VBAが途中で止まってしまい、そもそも私の表現がよろしくない事に気がつきました。
ファイルをアップ致しました。
http://www.geocities.jp/hartpopoo/test.xls
この中でシート名に"H"を追加しておりますが、敢えて別名にすることが便利だと考えました。
(手動で”北棟2”の範囲を”北棟2H”のシートのB8以下へ貼り付けしました)、他のシートにも同様に該当する(当てはめる)シートのB8へそれぞれデータを貼り付けたいと思っております。
頼り過ぎて申し訳ありません。
No.3
- 回答日時:
Sub test()
Dim m_Start As Object
Dim m_Tou As Variant
Dim Check As Boolean
Dim EndAddress As String
Dim i As Integer, j As Integer
m_Tou = Array("北棟2", "南棟1", "西棟2", "東棟1", "東棟3")
For i = 0 To UBound(m_Tou)
Set m_Start = Range("A:A").Find(what:="*" & m_Tou(i) & "*")
Check = True
j = 1
Do
If Range("A" & m_Start.Row + j).Value = "" Then
Check = False
EndAddress = Range("A" & m_Start.Row + j - 1).Address
End If
j = j + 1
Loop Until Check = False
Range(m_Start.Address & ":" & EndAddress).Copy
Sheets(m_Tou(i)).Range("B8").PasteSpecial
Next
Application.CutCopyMode = False
End Sub
でいかがですか
No.2
- 回答日時:
n-junです。
Sub try2()
Dim r As Range
Dim rr As Range
With Worksheets("Sheet1") ' データのあるシート
For Each r In .Range("A6", .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, 3).Areas
Set rr = r.Offset(1).Resize(r.Rows.Count - 1, 2)
rr.Copy Worksheets(r.Item(1).Offset(, 1).Value).Range("B8")
Next
End With
Set rr = Nothing
End Sub
こちらならどうでしょうか。
この回答への補足
何度もありがとう御座います。
rr.Copy Worksheets(r.Item(1).Offset(, 1).Value).Range("B8")
で止まってしまいます。シートレイアウトの伝え方がまずいのだと思います。
ファイルをアップ致しました。
http://www.geocities.jp/hartpopoo/test.xls
この中でシート名に"H"を追加しておりますが、敢えて別名にすることが便利だと考えました。
(手動で”北棟2”の範囲を”北棟2H”のシートのB8以下へ貼り付けしました)、他のシートにも同様に該当する(当てはめる)シートのB8へそれぞれデータを貼り付けたいと思っております。よろしくお願いします。
No.1
- 回答日時:
シート構成が今一不明でしたが。
・このシートはA~B列に値がある。
・このシートの6行目以下が対象である。
・このシートのA列にあるデータの塊のうち、
”小計”を除いた塊で1つ目はコピーするシート名を指定する。
・指定されたシートのB8以下に、このシートのA列の値をコピペする。
・各シートは事前に存在するものとする。
と判断しました。
Sub try()
Dim r As Range
With Worksheets("Sheet1") ' データのあるシート
For Each r In .Range("A6", .Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, 3).Areas
If r.Item(1).Value <> "小計" Then r.Copy Worksheets(r.Item(1).Value).Range("B8")
Next
End With
End Sub
ご参考になれば。
この回答への補足
早速のご回答ありがとう御座います、投稿後に修正が必要な事にに気がつきましたが回答を頂けるまで修正が出来ずに困っておりました。申し訳ありません。
A B C
5 xxxxxx名 日付
5行目までは不要な文字で御座います
6 空白 空白 空白
7 30010 北棟2 ←30010がA列 北棟2がB列(30010が記入漏れ)
8 1111 鈴木 5 抽出したいデータ部分(A:1111 B:鈴木 C:5)
9 2222 武田 5
10 11200 山田 5
11 4444 高橋 4
12 5555 佐藤 5
13 6666 小林 4
14 7777 村上 0
15 空白 空白 空白 ←空白の一つ上の行までが抽出したいデータ
16 【小計 28】←B列(B16セルに【小計 28】が入っております、値は変わります)
17 空白 空白 空白
18 30020 南棟1
29 30030 西棟2
A列のコード(30010)(30020)(30030)(30040)・・・(30070)か
B列の北棟2、南棟1、西棟・・・
を指定し、そこから次の行から空白(空白の前の行まで)をシートに転記できればと考えております。よろしくお願いします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルVBAについて 2 2023/01/31 16:21
- Excel(エクセル) capeofdragonと申します Excel2016を使っておりまして 半角又は全角の任意文字列が 2 2022/10/31 13:51
- Excel(エクセル) エクセルの条件付き書式 個人シートを参照して集計シートに色付けしたい 1 2023/06/22 00:39
- Excel(エクセル) Excelマクロ 差分抽出の方法が知りたいです。 2 2023/03/07 13:25
- その他(データベース) Accessのクエリで1フィールドの抽出条件設定をNullでなく全角半角含む空白のみの文字列でない文 1 2023/04/24 15:20
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- 新幹線 【鉄道】全国にある新幹線の駅の格付けランキングを作ってみました!皆様のご意見をよろしくお願いします。 1 2023/02/11 16:42
- Excel(エクセル) Excelについて質問です(ver2019) 1 2023/06/30 21:20
- Visual Basic(VBA) Excel VBA マクロ ある列の最終行迄を参照し、別の列の空白セルに値を入力したいです 2 2023/03/05 02:44
- Excel(エクセル) エクセル 自動計算 1 2023/01/30 13:28
このQ&Aを見た人はこんなQ&Aも見ています
-
「環境が人を育てる」って本当?環境によって人格や生き方は本当に変わるのか
環境が人生に与える影響は実際どれほどのものなのか、専門家の田宮由美さんに伺った。
-
エクセル セル内の文字列を空白から空白まで抽出したい。
Excel(エクセル)
-
スペースとスペースの間の文字を抽出する関数
Excel(エクセル)
-
EXCEL VBA セルに既に入力されている文字に文字を追加する
Excel(エクセル)
-
-
4
【EXCEL】【VBA】空欄は飛ばして処理する方法を教えて下さい。
Excel(エクセル)
-
5
リストボックスでの選択項目分削除について。
Visual Basic(VBA)
-
6
別のシートから値を取得するとき
Visual Basic(VBA)
-
7
エクセルVBAでTransposeの不思議
その他(Microsoft Office)
-
8
csvファイルを開かずに文字を検索し行を抽出したい
Visual Basic(VBA)
-
9
シート削除して同名シート追加するも#REFになる
Excel(エクセル)
-
10
エクセルで特定の文字を含むセルをコピーしたい
Excel(エクセル)
-
11
マクロを実行中に、msgbox を表示させたまま、ワークシートを上下左右に移動表示させたい。
Excel(エクセル)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで入力シートから別シ...
-
Excel 複数のシートからグラフ...
-
Excelの中央値の複数条件について
-
エクセル自動の年月
-
エクセルのワークシートが重く...
-
エクセルで別のシートのデータ...
-
Excelの選択肢をポップアップリ...
-
ExcelVBAで、指定したシートに...
-
Excel ハイパーリンク先のセル...
-
VBA セルの値と同じ名前のシー...
-
VBAでシート名をセルから取得し...
-
エクセルファイルを軽くする方法
-
日付を基準にして別シート転記...
-
質問:特定文字列から空白行ま...
-
EXCEL 1列に入力したデータを...
-
エクセルで入力→日付を自動判別...
-
データー読みこんでコピーさせ...
-
エクセルのデータ抽出について...
-
テキストボックス内の文字のふ...
-
Excelで数値→文字列変換で指数...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで入力シートから別シ...
-
Excel 複数のシートからグラフ...
-
Excelの中央値の複数条件について
-
VBA セルの値と同じ名前のシー...
-
ExcelVBAで、指定したシートに...
-
Excel ハイパーリンク先のセル...
-
IF, ISNUMBER, INDIRECTの組み...
-
エクセルのワークシートが重く...
-
エクセル シフト勤務表から、...
-
VBAでシート名をセルから取得し...
-
エクセルで入力→日付を自動判別...
-
エクセルVBA:表の内容を担当者...
-
質問:特定文字列から空白行ま...
-
エクセル マクロを使って日々...
-
VBAのoffsetの動き方について教...
-
エクセル自動の年月
-
エクセル:複数シートのデータ...
-
ピボットテーブルから抽出デー...
-
エクセルについて質問です 日付...
-
Excelの選択肢をポップアップリ...
おすすめ情報