• ベストアンサー
  • すぐに回答を!

マクロ、セルの値から行挿入して転記する方法

エクセル2013です。 セルA1に 1,8,9,15 セルA2に 7,12 セルA3に 20,14,28 と入力されているとします。 For~Nextで回して セルA1のカンマの数を InStr関数で数えて カンマが3個だから その3を変数に入れて それを利用して A2から3行行挿入します。 で カンマで区切られた順に A1には1 A2には8 A3には9 A4には15 と転記させる カンマは消してしまう で、この時点で 元々セルA2だった所は セルA5になっていて 7,12 が入力されているはずです。 で同じくそこを見させて カンマが1個だから A5の下に1行挿入したうえで A5に7 A6に12 と転記 カンマは消す。 すると元々セルA3だった所は セルA7になっていて そこには20,14,28が入力されているはず ここも同じように処理し 下の列へ進めて行く。 カンマが無いセルは 行挿入せず この処理はしないで A列のデータが有る最終行まで 繰り返す。 と いうマクロを作成したいのですが どういう方法で行えばいいか うまく思いつきません。 配列は苦手でなのですが 配列を使わないと無理でしょうか? どうかよろしくお願いします。

共感・応援の気持ちを伝えよう!

  • 回答数14
  • 閲覧数155
  • ありがとう数15

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.11
  • f272
  • ベストアンサー率45% (5479/11996)

#1 & #6 です。 > すべての行が元々1行名のA1~E1になってしまいます。 これに関しては申し訳ない。改造しておきました。 > そういう意味では全列挿入の方がよかったのかな?です。 これに関しても,そのように改造しておきました。 Sub Sample() Set key = Range("F1") 'カンマの入ったデータ列の最初の行 Set Rng = Range("A1:E1") '同時に行挿入する列の最初の行 Do If key.Value = "" Then Exit Do 'keyが空白ならループ脱出 i = InStr(key, ",") 'keyの最初のカンマの位置を調べる If i <> 0 Then 'keyの中にカンマの位置が見つかれば key.Offset(1).EntireRow.Insert Shift:=xlDown 'keyのセルの1行下に空白行を挿入 kv = key.Value 'keyの値をいったん覚えて key.Value = Left(kv, i - 1) 'keyの値のi-1文字目までをkeyのセルに入れる Set key = key.Offset(1) 'keyを1行下に変更して key.Value = Right(kv, Len(kv) - i) '元のkeyの値のi+1文字目から最後までを新しいkeyのセルに入れる Rng.Copy Rng.Offset(1) 'rngのセルの内容を1行下にコピー Set Rng = Rng.Offset(1) 'rngを1行下に変更 Else 'keyの中にカンマの位置が見つからなければ Set key = key.Offset(1) 'keyを1行下に変更 Set Rng = Rng.Offset(1) 'rngを1行下に変更 End If Loop Application.CutCopyMode = False End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ありがとうございます。 手作業と同じイメージで動作します。 また、中身も解読できました。 これなら、私の能力でも多少の改造もできそうですし、 他へ流用も可能そうです。 処理したいエクセルファイルによって違いますが、 データは100~300行でして、 F列の値がカンマ無しの1個だけの行が少なければいいのですが カンマが有る行の多さと、セル内のカンマの数(50個もある場合が) の多さもにも左右され、処理が終わると最終的な行数は、何十倍にもなります。 これを約100ファイルやらなければいけません。 平行で手作業でやってもらっていますが、拉致が空きません。 このコードで、一気に作業が加速すると思います。 ご丁寧に説明していただき、ありがとうございました。

関連するQ&A

  • 別シートの行を選択し対象列を転記するマクロ

    シート2のA~F列までデータがあります。 行数は10,000行です。(月ごとに100行くらい追加されます。) A列は項目がNO.で半角数字が連番で入力されてます。 セルA2→1 セルA3→2 セルA4→3 . . . セルA10000→9999 セルA10001→10000 という感じです。 シート1の セルI9に番号を入力すると シート2のその番号の行のB~F列の値を シート1のJ9~N9列に転記したいです。 例えば シート1のセルI9に100と入力したら、 シート2のA列が100と入力されているセルはA101ですから 101行目となります。101行目の各列の値を転記します。 ↓ シート1のセルJ9にシート2のセルB101の値を転記 シート1のセルK9にシート2のセルC101の値を転記 シート1のセルL9にシート2のセルD101の値を転記 シート1のセルM9にシート2のセルE101の値を転記 シート1のセルN9にシート2のセルF101の値を転記 シート1もシート2もセルの書式設定は標準。 B,E,F列は半角英数字の組み合わせで C,D列は半角数字のみです。 たまにF列に空白がある行があります。 B,F列は数字のみの場合もあります。 B,C,D,F列は数字のみの場合 「数値が文字列として入力されています」 となっています。 マクロで行いたいのですが記述そのものを教えてください。

  • 照合した結果によって決めた値を転記するマクロ

    シート1には A~F列まで値があり、行数は都度相違し約15,000行くらい。 データは2行目から開始です。 シート2には A~AE列まで値があり、行数は都度相違し約5,000~25,000行 あり同じくデータは2行目からです。 シート1の行ごとに A列,B列,C列の順で連結した値と シート2の行ごとに F列,G列,B列の順で連結した値を 照合させます。 その値が (1)シート1にもシート2にもある場合は   シート2のAF列に1と転記 (2)シート1には無いがシート2にはある場合は   シート2のAF列に2と転記 (3)シート1には有るがシート2には無い場合は   シート2のAF列に3と記入 シート2のデータのある行まで 作業を繰り返すマクロの記述を教えてください。 VLOOKUPを使用したマクロを作成しましたが 判定1,2,3の転記がうまく出来ないのと VLOOKUPが重すぎて処理が遅すぎるので 速く処理が出来るとうれしいです。 例 シート1 A2=XXXX B2=1234 C2=5678 シ-ト2 B2=1234 F2=XXXX G2=5678 シート1の値=XXXX12345678 シート2の値=XXXX12345678 照合する ↓(一致なので) シート2のセルAF2に1と転記

  • エクセルで常に変わるセルの値を参照するには

    教えて下さい。 エクセルで、列の一番下のセルの値をあるセルに表示したいのですが、行が増えても常に一番下の値を表示するにはどうすればよいのでしょうか。 例えば、 A2のセルに20 A3のセルに30 と数字が入っていたとします。 この場合は、A3の30をA1に表示します。 今後A4、A5、と数字が入ったらA5の数字を、A6に入ったらA6をと常に一番下の値をA1に表示するには、A1にどんな計算式を入れたら良いのでしょうか。

その他の回答 (13)

  • 回答No.3
  • kkkkkm
  • ベストアンサー率59% (1014/1709)

No2です。 配列を使わないで > For~Nextで回して > セルA1のカンマの数を > InStr関数で数えて > カンマが3個だから > その3を変数に入れて > それを利用して > A2から3行行挿入します。 このイメージのようにしてみました。 Sub Test2() Dim i As Long, j As Long Dim n As Long, Count As Long Dim mStr As String, buf As String For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1 mStr = Cells(i, "A").Value Count = 0: n = 0 Do n = InStr(n + 1, mStr, ",") If n = 0 Then Exit Do Else Count = Count + 1 End If Loop If Count > 0 Then Range(Cells(i, "A"), Cells(i + Count - 1, "A")).Insert (xlShiftDown) mStr = mStr & "," For j = 1 To Count + 1 Cells(i + j - 1, "A").Value = Left(mStr, InStr(mStr, ",") - 1) mStr = Mid(mStr, InStr(mStr, ",") + 1) Next j End If Next i End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご丁寧にありがとうございました。

質問者からの補足

ありがとうございます。 私の能力では解読に 時間がかかりそうです。 あと大変申し訳ありません。 説明不足でした。 考え方を知りたくて 例 で質問してしまいました。 本番で実行したいのは カンマが入ったデータはF列でして、F列を基準に処理を行うのですが A~E列にも別なデータが有ります。 行挿入したら、A~E列はデータは変化させないで、 そのまま行だけ下がらせたいです。 セルF1に1,2,3 セルA1にあ セルB1に五 セルC1にア セルD1にA セルE1に本 と入力されていたとして F1のセルのカンマは2個ですから 2行下がります。 F1に1 F2に2 F3に3 でももともと1行目にあった各データ をそのまま挿入された行に転記したいので セルA1、A2、A3にあ セルB1、B2、B3に五 セルC1、C2、C3にア セルD1、D2、D3にA セルE1、E2、E3に本 という具合です。 教えていただきました内容を、試しましたが 勿論、質問どうりに正しく動きました。 教えていただいたのはA列を基準ですから B列からF列に仮データを入力して試したのですが A列のみのデータが変化し、B列以降のデータは 行は下がらずそのままの位置に固定されたままです。 キチンと説明しなかったので当然なのですが。 ちょっと、私の能力では、教えていただいたコードを 改造し自分が求めるコードにするのは困難です。 申しわけございません。 処理が理解できた回答NO.1のf272様のコードを 別な処理も含めて改造してみた物の 自分が求める様には改造できませんでした。 最初からきちんと質問すべきで回答していただいた皆様に ご迷惑をおかけしてしまいました。 お手数をおかけして申し訳ございませんでした。 Sub 挿入() Dim 挿入数 Dim 元値 Dim 選択行 Dim 複写行 Range("F4").Select Do 元値 = Selection If 元値 = "" Then Exit Do 'セルの値が空白ならDoを抜ける 挿入数 = InStr(元値, ",") 'カンマの数を数えて挿入数に代入 If 挿入数 <> 0 Then '挿入数が0以外なら処理続行。0ならELSEへ Selection.Offset(1).Insert Shift:=xlDown '行挿入 Selection = Left(元値, 挿入数 - 1) '元値を変換して転記 Selection.Offset(1).Select 選択行 = Selection.Row 複写行 = 選択行 - 1 Range(Cells(複写行, 1), Cells(複写行, 5)).Copy Range(Cells(選択行, 1), Cells(選択行, 5)).PasteSpecial Application.CutCopyMode = False Selection = Right(元値, Len(元値) - 挿入数) '元値から転記済を除いて転記 Else Selection.Offset(1).Select End If Loop End Sub

  • 回答No.2
  • kkkkkm
  • ベストアンサー率59% (1014/1709)

配列を使いますが・・・ Sub Test() Dim mStr As Variant Dim i As Long, j As Long For i = Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1 mStr = Split(Cells(i, "A"), ",") If UBound(mStr) > 0 Then Range(Cells(i, "A"), Cells(i + UBound(mStr) - 1, "A")).Insert (xlShiftDown) For j = LBound(mStr) To UBound(mStr) Cells(i + j, "A").Value = mStr(j) Next j End If Next i End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご丁寧にありがとうございました。

質問者からの補足

ありがとうございます。 やはり配列は、難しいです。 昔1回作成したことが有りますが 今見ると解読できないので まだ身についておりません。 あと大変申し訳ありません。 説明不足でした。 考え方を知りたくて 例 で質問してしまいました。 本番で実行したいのは カンマが入ったデータはF列でして、F列を基準に処理を行うのですが A~E列にも別なデータが有ります。 行挿入したら、A~E列はデータは変化させないで、 そのまま行だけ下がらせたいです。 セルF1に1,2,3 セルA1にあ セルB1に五 セルC1にア セルD1にA セルE1に本 カンマは2個ですから 2行下がります。 F1に1 F2に2 F3に3 セルA1、A2、A3にあ セルB1、B2、B3に五 セルC1、C2、C3にア セルD1、D2、D3にA セルE1、E2、E3に本 という具合です。 教えていただきました内容を、試しましたが 勿論、質問どうりに正しく動きました。 教えていただいたのはA列を基準ですから B列からF列に仮データを入力して試したのですが A列のみのデータが変化し、B列以降のデータは 行は下がらずそのままの位置に固定されたままです。 キチンと説明しなかったので当然なのですが。 ちょっと、私の能力では、教えていただいたコードを 改造し自分が求めるコードにするのは困難です。 申しわけございません。 処理が理解できた回答NO.1のf272様のコードを 別な処理も含めて改造してみた物の 自分が求める様には改造できませんでした。 最初からきちんと質問すべきで回答していただいた皆様に ご迷惑をおかけしてしまいました。 お手数をおかけして申し訳ございませんでした。 Sub 挿入() Dim 挿入数 Dim 元値 Dim 選択行 Dim 複写行 Range("F4").Select Do 元値 = Selection If 元値 = "" Then Exit Do 'セルの値が空白ならDoを抜ける 挿入数 = InStr(元値, ",") 'カンマの数を数えて挿入数に代入 If 挿入数 <> 0 Then '挿入数が0以外なら処理続行。0ならELSEへ Selection.Offset(1).Insert Shift:=xlDown '行挿入 Selection = Left(元値, 挿入数 - 1) '元値を変換して転記 Selection.Offset(1).Select 選択行 = Selection.Row 複写行 = 選択行 - 1 Range(Cells(複写行, 1), Cells(複写行, 5)).Copy Range(Cells(選択行, 1), Cells(選択行, 5)).PasteSpecial Application.CutCopyMode = False Selection = Right(元値, Len(元値) - 挿入数) '元値から転記済を除いて転記 Else Selection.Offset(1).Select End If Loop End Sub

  • 回答No.1
  • f272
  • ベストアンサー率45% (5479/11996)

配列を使いたくないなら,こんな感じ Sub Sample() Range("a1").Select Do a = Selection If a = "" Then Exit Do i = InStr(a, ",") If i <> 0 Then Selection.Offset(1).Insert Shift:=xlDown Selection = Left(a, i - 1) Selection.Offset(1).Select Selection = Right(a, Len(a) - i) Else Selection.Offset(1).Select End If Loop End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご丁寧にありがとうございました。

質問者からの補足

ありがとうございます。 これでしたら、私でもわかります。 ただ説明不足でした。 考え方を知りたくて例で質問してしまいました。 やりたいのは カンマが入ったデータはF列でして、A~E列にもデータが有ります。 行挿入したら、A~E列も一緒に下がってほしいのですが 教えていただきました内容を、F列に置き換えて 別な処理も含めて作成しましたが F列だけが単独で行挿入されてしまいます。 Selection.Offset(1).Insert Shift:=xlDown の部分を改造しないといけないのかと思っているのですが 思うようにいきません。 考え方を教えてもらい、あとは自力でと 思ったのですが、能力不足でできません。 申しわけございません。 Sub 挿入() Dim 挿入数 Dim 元値 Dim 選択行 Dim 複写行 Range("F4").Select Do 元値 = Selection If 元値 = "" Then Exit Do 'セルの値が空白ならDoを抜ける 挿入数 = InStr(元値, ",") 'カンマの数を数えて挿入数に代入 If 挿入数 <> 0 Then '挿入数が0以外なら処理続行。0ならELSEへ Selection.Offset(1).Insert Shift:=xlDown '行挿入 Selection = Left(元値, 挿入数 - 1) '元値を変換して転記 Selection.Offset(1).Select 選択行 = Selection.Row 複写行 = 選択行 - 1 Range(Cells(複写行, 1), Cells(複写行, 5)).Copy Range(Cells(選択行, 1), Cells(選択行, 5)).PasteSpecial Application.CutCopyMode = False Selection = Right(元値, Len(元値) - 挿入数) '元値から転記済を除いて転記 Else Selection.Offset(1).Select End If Loop End Sub

関連するQ&A

  • 行の挿入で数式も自動的に挿入

    C1列に=SUM(A1:B1)を入力し、オートフィルを30行目までかけました。 3行目で行の挿入をした時に 自動的にC列に数式が入力されている状態 (上の行、又は下の行のコピーを挿入) にしたいのですがどうすればよろしいでしょうか? 行をコピー  → コピーしたセルの挿入 以外の方法はあるんでしょうか? よろしくお願い致します。

  • VBAでi行j列ずれたセルの値

    VBAでセルA1にTESTという名前を定義しているとします。 セルA1はRange("TEST")で値を取得できますが、 セルA1からi行j列ずれたセルの値はどうやって取得できるのでしょうか? 今までは、Cells(1+i,1+j)で取得していましたが、 行や列を挿入することもあるので、セルに名前を付けたいと思います。

  • エクセルのマクロで転記

    シート1とシート2があり、 シート1の20Aから39Lまでのセルの中に情報を書き込んでいます。 シート1の20Lから39LのL行で、数値が入っているセルがあれば、その行のA、B、I、L列と、J2、A7を取り出し、シート2の2行目から下に転記していくのですが、 シート2のA列にはシート1のJ2を、B列にはシート1のA7を、C列以降は、シート1のA、B、I、Lを入れるようにします。 また同じ条件がシート1で発生すれば、シート2の3行目以降に転記していく感じです。 どのようにすればいいでしょうか。

  • 列挿入時の指定文字入力と転記をマクロでやりたい

    毎月、アンケート集計結果がエクセルで送られてきます。 中身は、商品名ごとにシートが分かれており、1行目はタイトル行となっています。(月によってデータ個数は変わります。) 年度毎の累計を別ブックで1枚のシートで作成したいと思っております。 その際マクロで、A列に月、B列に商品名と挿入し、かつ自動で、月と商品名が入力されるようにはできないでしょうか? A  B   C D 1 時間 名前 ~ ~  2 ○時 ○○ 3 ○時 ○○    ↓ A  B   C   D 1 月 商品名 時間 名前 ~ ~  2 ○月 ○○ ○時 3 ○月 ○○ ○時 また、タイトル行を除いた、複数の特定の列の最終行(入力されているセル)を取得し(上記とは別)別ブックの最終行(入力されているセルの次の空白セル)に転記できますか?

  • 文字列の数抽出、行挿入マクロ

    急きょ下記処理を実施することになったのですが、本やネットで下記処理ができるような マクロを色々探していもなかなか見つからず…。(T_T) どなたか詳しい方がいらっしゃいましたら教えていただけませんでしょうか? ・A列に特定の文字列(;)があった場合、その列をコピー。 ・その列の下に文字列(;)の数と同数の行を挿入。 ・挿入した行のAセルに、文字列(;)のすぐ後ろの1ケタを貼り付け。 ・(挿入行が2行の場合) さらに下に挿入した行のAセルに、左から2つ目の文字列(;)の  すぐ後ろの1ケタを貼り付け。 なお、A列の行数は、現時点で500行ほどあり、今後増える可能性もあります。 【処理する前】       A列      B列    C列 1行目  1;32     555   AAA 2行目  29;1;4   222   GGG 3行目  600      111   FFF 【マクロ実行後】       A列    B列   C列 1行目  1     555   AAA 2行目  32    555   AAA 3行目  29    222   GGG 4行目  1     222   GGG 5行目  4     222   GGG  6行目  600   111   FFF どうぞよろしくお願いいたします。

  • 条件にあてはまる場合、行挿入+値を移動させるマクロ

    Excel2003、WindowsXPを使用しています。 説明が分かり難いところがあるかもしれませんが、よろしくお願いいたします。 1.C列に値が入っていた場合、下に行を挿入。 2.挿入した行のB列に、C列に入っていた値を移動。 3.D列に値が入っていた場合、さらにその下に行を挿入。 4.挿入した行のB列に、D列に入っていた値を移動。 5.E列に値が入っていた場合、さらにその下に行を挿入。 6.挿入した行のB列に、E列に入っていた値を移動。 というように、C-E列に値が入っていた場合、下に行を挿入し、 挿入行にその値を移動させるマクロを教えてください。 (実行前)    A列     B列  C列  D列  E列   F列 ああああ  AAA  BBB  CCC  DDD  12222 うううう    EEE                   544 くくく     FFF  GGG  VVV        8 すす     TTT   BBB            4300 (実行後)  A列     B列   C列 ああああ  AAA   12222 ああああ  BBB   12222 ああああ  CCC   12222 ああああ  DDD   12222 うううう    EEE    544 くくく     FFF    8 くくく     GGG   8 くくく     VVV    8 すす     TTT    4300 すす     BBB   4300 上記実行後のように、マクロで出来たら…と思っています。 どうぞよろしくお願いいたします。

  • 各ボックスの値を、指定セルに転記したいのですが

    エクセル2007で作成 ・入力シートでユーザーフォーム1を呼出す。 B列の最終行をアクティブセルとする ・コンボボックス1にて部署名を選択。 ・コンボボックス2にて個人名を選択。 Sub ComboBox2_Click() Dim lastRow As Long Dim myLlist As String Dim R As Long myLlist = ComboBox2 With UserForm1 Select Case myLlist Case "○○ △△" ’個人名 .ListBox1.RowSource = "○○!B1:B100" ←B100ではなく、最終行に変更したい End Select End With End Sub ・リストボックス1にて作業名を選択(複数可)後、決定コマンドボタンにて確定。  入力シートのアクティブセルにコンボボックス1の値を転記  右隣セルにコンボボックス2の値を転記  さらに右隣にリストボックス1の値を転記 Sub 決定_Click() ActiveSheet.Unprotect Dim 行 As Long Dim 列 As Long Dim i As Integer Dim LB As String With UserForm1 行 = ActiveCell.Row 列 = ActiveCell.Column UserForm1.ComboBox1.Value = Cells(行, 列) UserForm1.ComboBox2.Value = Cells(行, 列 + 1) With ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) = True Then LB = LB & .List(i, 0) LB = Cells(行, 列 + 2) ←ココを変更したい End If Next i End With End With End Sub 個人名シートの指定範囲は、最終行までとしたい。 転記後、D列の1セルの中に選択した複数の作業名が入ってしまうので、 作業名単位で行を分けたい。 その時、同一部署なら同名をB列の下の行に、 同一人物なら同名もC列の下の行に転記したい。 以上、行いたい事項です。 方法がわからず困っています。 どなたかご教授頂きますよう、宜しくお願い致します。

  • 急!!Excel VBA 転記マクロを教えて下さい

    Excel VBA超初心者です、 急ぎ作らなければならない資料があり、ご助力願います。 次の様な転記するアクションをコマンドボタンに設定したいです。 Sheet1の列A(先頭セルA2)に入力したデータを、 追加した(入力間違い等を除き、保存した)データ分だけ Sheet2の列B(先頭セルB3)の最終行から転記させていく。 列Aに入力したデータは、並び替えをするので (この分は、今回のVBAに含みません。入力・転記後、Sheet1で普通に並び替えをします。) 列Aと列Bのデータの順番が異なる。 以上です。 どうぞ宜しくお願いします。

  • エクセルで空白行を挿入するには

    一つの列に200ほどデータがあるとします。 そこで1行おきに空白行を挿入していきたいのですが手でいちいち空白行を挿入していてはらちがあきません。 関数等も含めて、なにか良い方法はないでしょうか。 例 セルA1   セルA2   セルA3 以下続く    ↓   セルA1   空白行(セル)   セルA2   空白行(セル)   セルA3   空白行(セル) 以下続く   といった具合です。

  • excel vba セルへの一括挿入

    Excel+VBで簡単なシステムを作成しております。 VBでテキストファイルを読み込み、ある桁数で分割して2次元配列に格納しています。(行:レコード 列:カラム) 現在は、要素ごとにセルを指定して挿入しているのですが、レスポンス向上のため、行単位でセルに挿入できると聞きました。 具体的には以下です。 配列 (0,0)="A" (0,1)="AA" (0,2)="AAA" (1,0)="B" (1,1)="BB" (1,2)="BBB" (0,0)をセルA1に、(0,1)をセルC1に、(0,0)をセルE1に1文で挿入。 もちろん、セルA1:E1に対して配列値を代入する形になると思うのすが、記述の仕方がわかりません。 お分かりになる方が見えましたら、ご教授願います。

専門家に質問してみよう