Excelの改行について
- 特定のキーワードをもとに1シートにまとまったデータを複数のシートに分割する方法について教えてください。
- データ数が要素によって異なるため、一概に100データずつ区切ることはできません。
- 「要素A」を含む行から「要素B」直前行までを一つのシートにして、要素分だけシートを作成したいと思っています。
- ベストアンサー
Excelの改行について
あるシートの中に複数のデータが存在します。 特定のキーワードをもとに1シートにまとまったデータを複数のシートに分割したいと思います。 (例) 要素A ・・・ データ5 データ6 データ7 要素B データ1 データ2 データ3 要素C ・・・ データ16 データ17 データ18 つまり「要素」というキーワードで開始行はわかるのですが、データ数が要素によって異なるので、一概に100データずつ区切るのようなことは不可能です。 「要素A」を含む行から「要素B」直前行までを一つのシートにして、要素分だけシートを作りたいと思います。 どのようなマクロを組めばよいでしょうか。 何方様かご教授願います。
- Timper1912
- お礼率41% (64/153)
- オフィス系ソフト
- 回答数6
- ありがとう数1
- みんなの回答 (6)
- 専門家の回答
質問者が選んだベストアンサー
う~ん、必ず「要素」がある1行目から始めるようになっているからnRowがEmptyにはならない筈だったんですけどね。 ひょっとして「要素」を含んでいるけど「要素」では始まらない行があるんですかね。 だとしても違ったエラーになるはずなんですが……。 コードを以下のように変更してみて下さい。 If Left(vData, 2) = "要素" Then ↓ If InStr(vData, "要素") > 0 Then
その他の回答 (5)
- mt2008
- ベストアンサー率52% (885/1701)
ANo.2、ANo.4です > 実行してみると「インデックスが有効な範囲にありません」と”Sheets(2).Cells(nRow, nCol) = vData”に対してエラーになってしまいます。 もしかして、シートは1枚しかないブックですか? でしたら、空のシートを一枚最後尾に追加してからマクロを動かしてみて下さい。
- mt2008
- ベストアンサー率52% (885/1701)
ANo.2です。 > 今回は各シートに分けるという事でお願いしたのですが、同シート内で要素を空白列を設けて配置することは可能でしょうか? こっちの方がはるかに簡単ですよ。 自シートのデータを書き換えるのは嫌だったので、Sheet2に要素毎に横に並べたものを作るようにしました。 Sub Sample2() nLast = Cells(Rows.Count, 1).End(xlUp).Row nStart = Columns("A:A").Find(What:="要素", After:=Cells(nLast, 1)).Row nCol = -1 For i = nStart To nLast vData = Cells(i, 1) If Left(vData, 2) = "要素" Then nCol = nCol + 2 nRow = 1 End If Sheets(2).Cells(nRow, nCol) = vData nRow = nRow + 1 Next i End Sub
補足
早速ありがとうございます。 実行してみると「インデックスが有効な範囲にありません」と”Sheets(2).Cells(nRow, nCol) = vData”に対してエラーになってしまいます。 どこを修正すれば良いのでしょうか…。
- tsubuyuki
- ベストアンサー率45% (699/1545)
不確定要素があるので、完全な回答とは言えません。 質問文中にあるとおり、区切るキーワードが全て「要素*」であること、 これらデータが全てA列にあることが条件で組んであります。 Sub sample() Dim MaxRow As Long, TagRow As Long, i As Long Dim OldSheet As Worksheet, NewSheet As Worksheet Set OldSheet = Sheets("Sheet1") MaxRow = OldSheet.Cells(OldSheet.Rows.Count, 1).End(xlUp).Row TagRow = MaxRow For i = MaxRow To 1 Step -1 If OldSheet.Cells(i, 1) Like "要素*" Then Set NewSheet = Worksheets.Add() NewSheet.Name = OldSheet.Cells(i, 1) OldSheet.Rows(i & ":" & TagRow).Copy NewSheet.Range("A1") TagRow = i - 1 End If Next i End Sub これで十分出来ます。 質問文からは読み取ることがどうしても出来なかった条件として、 ・どの列をどれだけ持っていけば良いのかわからないので、行全体をコピーしています。 ・コピー先のブックの指定もありませんので、同一ブックの先頭に新規シートを挿入しています。 ・コピー元のブックに関しても削除や修正などの考慮はしていません。 などなどが挙げられます。 その他に何か「質問文中に無い条件」があるとすると、 コレだけでは思い通りには動きませんのでご注意下さい。
補足
ご回答ありがとうございます! すみません!質問文には書いておりませんでしたがそれぞれの要素は、列数は4列で構成されます。 行数は要素によって異なるので不定数です。 つまり生データでは「要素*」で始まる*行4列のデータセットが*個、1シートに存在しています。 これをデータセットごとに再配置したいということなのです。
- mt2008
- ベストアンサー率52% (885/1701)
A列にある「要素…」を探して処理するようにしました。 あくまでサンプルですので、エラー処理等は含めていません。悪しからず。 Sub Sample() Dim nRow() nLast = Cells(Rows.Count, 1).End(xlUp).Row nCount = WorksheetFunction.CountIf(Range("A:A"), "要素*") If nCount < 2 Then Exit Sub '「要素」の数が2未満ならシートを作る必要なし ReDim nRow(nCount) nRow(nCount) = nLast + 1 nRow(0) = Columns("A:A").Find(What:="要素", After:=Cells(nLast, 1)).Row For i = 2 To nCount nRow(i - 1) = Columns("A:A").FindNext(After:=Cells(nRow(i - 2), 1)).Row Next i ’新規シート作成 sShtName = ActiveSheet.Name For j = 1 To nCount Call fMkSheet(sShtName, nRow(j - 1), nRow(j) - 1) Next j Worksheets(sShtName).Select End Sub Sub fMkSheet(aName, aRow1, aRow2) Worksheets(aName).Rows(aRow1 & ":" & aRow2).Copy Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Paste End Sub
補足
お礼、遅くなりましてすみませんでした。mt2008さんのマクロで目的の動作は実行できました!ありがとうございました(><) さらにお願いがあるのですが、 今回は各シートに分けるという事でお願いしたのですが、同シート内で要素を空白列を設けて配置することは可能でしょうか? (例) 要素A [空白列] 要素B [空白列] 要素C ・・・ □ データ1 □ ・・・ データ5 □ データ2 □ データ16 データ6 □ データ3 □ データ17 データ7 □ データ4 □ データ18 更にご教授願います!
- cj_mover
- ベストアンサー率76% (292/381)
こんにちは。 こちらの理解が至っていない部分もあるでしょうけれど、 想定できるものを拡張解釈して動くものを書きました。 そちらで、修正が難しいようでしたらば、補足欄などを使って 相談してみてください。 追加するシートの数が多過ぎる場合は、他の方法を考えた方がいいので、 そうと解れば改めて着手します。 ex.) 分割する各セクションの参照文字列を作ります。 "A1:E5,A7:E10,A11:A14" 作成した参照文字列を基にセル範囲を取得します。 Range("A1:E5,A7:E10,A11:A14") セル範囲を領域毎にコピーします。 Range("A1:E5,A7:E10,A11:A14").Areas(i).Copy 後は基本技術の応用だけです。 Sub Re8121992() Const SRCCOL As Long = 1 ' ■ 要指定、元データの検索対象列位置 ■仮にA列 Dim sRECol As String ' 最終列の参照文字列(":E"とか":RC"とか) Dim sRef As String ' セクション毎の参照文字列(カンマ区切り) Dim nBtm As Long ' 元データの最下行 Dim nABtm As Long ' セクション毎の最下行(フラグ) Dim tnAddSh As Long ' 追加するシート数=セクション数 Dim nIdxSrcSh As Long ' 元データシートのインデックス Dim i As Long Application.ScreenUpdating = False With Sheets("Sheet1") ' ■ 要指定、元データ、シート名 ■仮に"Sheet1" With .UsedRange nBtm = .Row + .Rows.Count - 1 ' 元データの最下行 sRECol = ":" & Split(.Columns(.Columns.Count).Address, "$")(3) ' 最終列の参照文字列(":E"とか":RC"とか) End With For i = nBtm To 1 Step -1 If nABtm Then ' セクション毎の最下行(フラグ) If .Cells(i, SRCCOL) Like "要素*" Then ' セル値が"要素*"で始まるなら sRef = ",A" & i & sRECol & nABtm & sRef ' セクション毎の参照文字列(カンマ区切り) nABtm = Empty End If ElseIf .Cells(i, SRCCOL) <> "" Then nABtm = i ' セクション毎の最下行 End If Next i nIdxSrcSh = .Index ' 元データシートのインデックス tnAddSh = UBound(Split(sRef, ",")) ' 追加するシート数=セクション数 If tnAddSh < 2 Then Exit Sub ' 追加の必要なければ抜ける Worksheets.Add After:=ActiveSheet, Count:=tnAddSh ' シート数に応じてシート追加 With .Range(Mid$(sRef, 2)) ' セクション毎に分けてあるセル範囲を纏めて取得 For i = 1 To tnAddSh Sheets(nIdxSrcSh + i).Name = .Areas(i).Cells(1) ' シート名変更 .Areas(i).Copy ' 元データ、セクション毎(指定したセル範囲の領域毎)にCopy With Sheets(nIdxSrcSh + i) ' 対応したシートの With .Cells(1) ' セルA1に .PasteSpecial Paste:=xlPasteColumnWidths ' 列幅を貼付け .PasteSpecial Paste:=xlPasteAll ' すべて貼付け End With End With Next i End With End With ' With Sheets("Sheet1") Application.CutCopyMode = False End Sub
お礼
ご回答ありがとうございます! 今回はmt2008さんのマクロを採用させて頂きました。 さらに同シート上にデータセットを再配置することができるマクロがあればご教授願います!
関連するQ&A
- エクセルのVBAマクロで検索と結果表示(抽出)
エクセルのVBAマクロで検索と結果表示(抽出)を行いたいです。 業務で使用している膨大なリストデータから、特定のキーワードで情報の絞り込みを行いたいのですが、上手くマクロが組めません。 機能としては、シート1で特定のキーワード(テキストボックスに)を入力し検索ボタンを押下すると、 シート2のリストデータから検索に引っかかったセルの"行"を、シート1にリストアップ(貼り付け)していくようなマクロを作りたいのです。 シート2にはB列~AH列xn行のリストデータがあり、シート2のK列のセル内から「シート1のテキストボックスで入力したキーワードを含む」検索を行い、 HITした行をシート1のA9の行から結果として表示を行いたいんです。 簡単に言えばオートフィルタ機能の部分一致版を作りたいのですが・・・。 (オートフィルタでは完全一致でしか抽出が出来ないので) そして、検索ボタンを押下すると前回結果はクリアしたいです。 ネット上のサンプル等も参考にしながらやってみたのですが上手く行きません。。。 どなたか上記のマクロ文をご教授願えないでしょうか。 必要な情報(シート2の特定の列)のみ表示させたいとも思いましたが、むずかしくて断念・・・。 もし可能でしたらこちらもお願い致します。 よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- エクセル:シートの分割
お世話になります。 エクセルで、あるシートに任意の行数のファイルがあります。 1~6行目はタイトル行扱いで、7行目からがデータ部分になります。 この7行目からはじまるデータ部分を25行分ずつシート単位で分割したいのです。 1つ目のシートが分割前の本データとすると、2つ目のシートには1~6行目と7~31行目、2つ目のシートは1~6行目と32~56行目… というように。 必ず各シートの先頭は1~6行目部分になります。 1つ目のシートが分割前のシートで、2つ目以降に25行分ごとに分割されたシートがどんどん追加されていくイメージです。A列には必ずデータが入っているので、A列にデータが入っている最終行までが処理の対象になります。 追加するシート名は、分割1、分割2…というようにしたいです。 このような処理を自動化するマクロができれば教えてください。
- ベストアンサー
- オフィス系ソフト
- Excel マクロ 改行数を求めたい
いつもお世話になってます。 今Sheet1のC列のデータをSheet2のD列に移すマクロを作っていますが、 Sheet1には1~4行位のセルもあり、それを1行毎に分割してコピーしたいと考えています。 Splitで分割してみたのですが、 tmp = Split(Range("C1"), chr(10)) Sheets("Sheet2").Select Range("D9")=tmp(0) Range("D10")=tmp(1) Range("D11")=tmp(2) Range("D12")=tmp(3) といった感じにすると 改行数が1~3の場合、エラーが出てしまいます。 (実際にはC列にデーターがある分だけ上記を繰り返します。) そこで改行数を求めようとしましたが、 a = InStr(Range("C1"), chr(10)) これでは何行あっても数値(この場合は"a")が10になってしまい、うまくできません。 何かいい手段がありましたらご教授願います。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルのマクロについて質問です。
エクセルのマクロについて質問です。 複数のsheet(毎回数が変わります)があり、集計シートにデータを貼り付けたいのですが 複数Sheetのデータを集計シートの1行に貼り付けます 複数Sheet1 J1→集計Sheet A2 複数Sheet2 J1→集計Sheet A3 複数Sheetが毎回数が違うので、どうのようにマクロを組んだらよいのでしょうか。 以上、よろしくお願いいたします。
- ベストアンサー
- Visual Basic
- Excelマクロについて
マクロについて質問をさせていただきます。 A1~10にデータが入力されています。 その中である特定の文字が入っている行をシート2にコピー(移動でもかまいません)するようなマクロはどのように作成すればよろしいでしょうか?? 宜しくお願いいたします。
- ベストアンサー
- その他(プログラミング・開発)
- エクセル集計
エクセルで質問です。 sheet1 列 A B 行 (名称) (判定) 1 あいうえお A 2 あいうえお C 3 かきくけこ C 4 かきくけこ B 5 かきくけこ B という元データがあり、みてのとおり同じ名前のものが複数あり各々で判定が違います。 次に、別のシートには(※同じシートで列をAAとしてもよいが) sheet2 列 A B C D 行 判定 1 A B C 2 あいうえお 1 1 3 かきくけこ 2 1 という具合に、A列には名前が複数あってもひとつとしその右側に判定の種別ごとに数を記入する。 という集計表を作成したいのですが、どなたか教えてください。 ちなみにマクロはできませんのであしからず・・・・
- ベストアンサー
- その他MS Office製品
- データ エクセルの改行
いつもお世話になります。 取引先からあるデータをエクセルで頂きましたが、それはA列に1行~8000行まであるデータでした。それをそのまま印刷しようとすると、A4用紙で60枚以上になり大変です。A列にしかないので指定した行で改行し1ページにそのデータをなるべくまとめて印刷したく思います。 1 (株)A社 2 (有)b社 3 (株)c社 4 d商店 5 e商事 | ・・・・ 7998 f会社(株) 7999 g社 8000 h商店 マクロ組むしかないでしょうか?それしかないならマクロ初心者の私にも出来る方法あれば本あるいはHP教えていただけないでしょうか? よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- ExcelのVBAについて
ExcelのVBAについて VBA全くの初心者です。 以下のような処理を行いたいのですが、どなたかご教授をお願いします。 以下のように支店(1)~(3)のシートがあります。 1.入力シートに調べたい商品No・商品名・備考を入力する(複数行あり) 2.マクロを実行すると、商品Noを検索対象として支店(1)~(3)シートをチェックし、 一致しない行を不一致データシートに出力する もう一つ別のマクロで、 1.入力シートに調べたい商品No・商品名・備考を入力する(複数行あり) 2.マクロを実行すると、商品Noを検索対象として支店(1)~(3)シートをチェックし、、 一致する行を一致データシートに出力し、D列に対象データがあるシート名を表示する ※可能でしたら、E列に対象データがある行番号も表示する -------------------------------- シート名:支店(1) A B C 商品No 商品名 備考 011 商品A 備考A 009 商品B 備考B 015 商品C 備考C -------------------------------- シート名:支店(2) A B C 商品No 商品名 備考 008 商品A 備考A 023 商品B 備考B 004 商品C 備考C -------------------------------- シート名:支店(3) A B C 商品No 商品名 備考 007 商品A 備考A 033 商品B 備考B 018 商品C 備考C -------------------------------- シート名:入力シート A B C 商品No 商品名 備考 ※ここに複数行入力する -------------------------------- シート名:不一致データシート A B C 商品No 商品名 備考 ※ここに出力される -------------------------------- シート名:一致データシート A B C 商品No 商品名 備考 ※ここに出力される
- 締切済み
- Visual Basic
- マクロを使用し、EXCELのデータから必要な部分を取り出し2つのsheetに貼り付けたい
条件 EXCELのデータ A列からL列まで 複数行(行数は、決まっていない) (例) 40行ほどあるデータを見て 1行目から10行目までをsheet1に 12行目から20行目までをsheet2に貼り付けたい場合。 11行目のA列(空白になっている)に手入力で「a」と入力 21行目のA列(空白になっている)に手入力で「b」と入力し、 1行目から「a」のある行までをコピーし、sheet1に貼り付ける 「a」のある行より1行下から「b」のある行までをコピーし、sheet1に貼り付ける 以上のことをマクロで実行する方法を教えて下さい。
- ベストアンサー
- オフィス系ソフト
- EXCELのマクロがわかりません・・・
現在、A列にデータが並んでいるのですが、 これを7つ区切り(例:A1~A7、A15~A21)にして、 別シートに用意した表に行列を入れ替えて、 貼り付けるマクロを作っているのですが、 なにぶんVBは素人ですので、よくわかりません。 今作ろうとしているマクロは、 「元データ」セルのA1からA7までをコピーして、 「作成データ」セルのB2を起点として、 コピーした内容の行列入れ替えを行い貼り付け、 以後、「元データ」のコピー範囲を7つづつ 下にずらし、「作成データ」の貼り付け起点を 1つづつ下にずらして、「元データ」のA列の 最後までくりかえすものです。 必ず「Range」文で引っかかってしまうのですが、 何か構文的におかしいでしょうか? かなり急ぎですので、 わかる方、よろしくお願いしますっ!! 下に、作成したマクロを貼り付けます。 Sub Macro3() ' ' Macro3 Macro ' マクロ記録日 : 2005/12/5 ユーザー名 : *** Worksheets("元データ").Activate 開始行 = -6 終了行 = 0 ペースト行 = 0 Do 開始行 = 開始行 + 7 終了行 = 終了行 + 7 ペースト行 = ペースト行 + 1 開始セル番号 = "A" & 開始行 終了セル番号 = "A" & 終了行 ペーストセル番号 = "B" & ペースト行 Range("開始セル番号:終了セル番号").Select Selection.Copy Sheets("作成データ").Select Range(ペーストセル番号).Select Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _ , Transpose:=True Loop End Sub
- ベストアンサー
- オフィス系ソフト
補足
ありがとうございます。 空シートを加えてみたのですが同じエラーが出てしまいます…。 デバッグでウォッチしてみると「nRow」がEmpty値になっていますがこのままで宜しいのでしょうか?