EXCEL2010 VBA 列名の変更
- EXCEL2010 VBAを使用してA列の列名を変更する方法を教えてください。
- 現在、A1には「SID00」という列名があり、B1以降は「Q1_01」「Q1_02」などの列名が続いていますが、これを「SID00」「Q1_01」「SID01」「Q1_02」のように変更したいと思っています。
- 現在はVBAのLOOPを使用し、列の挿入を行っているのですが、うまくいきません。どのようにすれば列名を変更できるでしょうか？
- ベストアンサー
ＥＸＣＥＬ2010 VBA 列名の変更
A1に、"SID00"と列名が入っています。 B1以降は"Q1_01、Q1_02・・・・と列名が続いています。（列数固定ではなく変化します。） A列をコピーし、1列おきに挿入する作業を下記VBAで行いました。 すると、1行目は"SID00"、"Q1_01"、"SID00"、"Q1_02"、"SID00"、"Q1_03"・・・となるのですが、 これを"SID00"、"Q1_01"、"SID01"、"Q1_02"、"SID02"、"Q1_03"のようにしたいと思っています。 下記LOOPの後にオートフィルの設定などをしてみたのですがうまくいきません。 LOOPに組み込んでしまうのが一番いい方法なのでしょうか？ どちらにしろ、VBAをはじめたばかりで色々調べて試してはみていますが なかなかうまくいきません。どのようにすればいいのでしょうか？ お分かりになる方、おしえていただけますでしょうか？よろしくお願いいたします。 Dim Ccnt As Long Dim i As Long Const copycolumn = 1 '※ 最初にコピーする列 Const rightcolumn = 2 '※ 挿入する列の位置(～列数分右に挿入) With ActiveSheet.Range("A1").CurrentRegion .Ccnt = .Columns.Count .Columns(copycolumn).Copy i = copycolumn + rightcolumn Do .Columns(i).Insert Shift:=xlToRight .Columns(i).Copy '次の分コピー Ccnt = Ccnt + 1 '挿入分1行増加 i = i + rightcolumn '次の行番号 Loop Until i > Ccnt + 1 End With Application.CutCopyMode = False End Sub
- xoxo_jj
- お礼率69% (9/13)
- オフィス系ソフト
- 回答数2
- ありがとう数2
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
一例です。 Sub 一例() 項目名 = Left(Cells(1, 1), 3) For i = Cells(1, Columns.Count).End(xlToLeft).Column To 3 Step -1 Columns(1).Copy Columns(i).Insert Shift:=xlToRight Cells(1, i) = 項目名 & Format(i - 2, "00") Next Application.CutCopyMode = False End Sub
その他の回答 (1)
- imogasi
- ベストアンサー率27% (4737/17068)
質問がわかりにくい。 質問文に誤りがあるのでは？＞A列をコピーし、ほんとにA列？。私は第１行目かと思ったが。 下記コードもそのつもりなので間違っていたら、すべて無視して。 また模擬実例を挙げて説明すること。そうすれば私のようなことは言わなくて済むのだ。 初心者ならコードなどどうでもよい。良さそうな回答のやり方を勉強せよ。 まあやってみた証に挙げておくべきだが。 ーー 私なら、コピーなどしない。 ロジック的（＝ルールをコードにして）に見出しを作る。 Sub test01() i = 5 '見出しを入れる行 Cells(i, "A") = Cells(1, "A") r = Range("IV1").End(xlToLeft).Column z = Cells(1, r) MsgBox z x = Cells(i, "A") n = Val(Right(x, Len(x) - 2)) For c = 1 To 10 Step 2 Cells(i, c) = "SID" & Format(n, "00") Cells(i, c + 1) = "Q1_" & Format(n + 1, "00") n = n + 1 If Cells(i, c + 1) = z Then Exit For Next c End Sub ーー 上記は５行目に見出しをつくる例。 Q１_XXの最後（最右列）を取得 ＳＩＤのあとの数字文字部分を取得 A列から１列飛ばしでその数字に＋１し、文字列として SIDに結合 Q１_のあとの部分は各列で＋１していく。 結果 第１行目 SID00 Q1_01 Q1_02 Q1_03 Q1_04 第１行目の次に見出しを入れる行 本件第５行目 SID00 Q1_01 SID01 Q1_02 SID02 Q1_03 SID03 Q1_04 ーー 見出しを入れる行の割り出し方は、質問がごたごたして わかりにくく、略。 ーーー こういうルール性（どういう規則性か）を見抜くことが、 それをどうコード化するか（普通は繰り返し処理に持ち込む） 勉強には肝心だ。
お礼
imogashi様 質問が分かりづらくてすみません。 そんななか、ご回答をいただいてありがとうございます。 質問のしかたやコードの記述、ロジックなど色々と勉強になり、大変感謝しております。
関連するQ&A
- VBA 100行ごとに列を変更してコピーする。
Winは7、Excelは2013を使用しています。 A列とB列のデータを100行毎に列を変えてコピーしたいと思っています。 （画像参照願います。） それで、別シートにコピペするサンプルコードを見つけたのですが、 同シート内でする様に変更する知識がなく、苦戦しています。 申し訳ありませんが、ご教示願います。 別シートにコピペするサンプルコード Sub データを100行ごとに分割する() Dim シート As Worksheet, 元 As Worksheet '元は元データのあるシート Dim 総行数 As Long, 回数 As Long, i As Long, 開始行 As Long Const コピー行 = 100 Set 元 = ActiveSheet '変数の元をActiveSheetにセットする 総行数 = 元.UsedRange.Rows.Count 回数 = Int(総行数 / コピー行) + IIf(総行数 Mod コピー行 > 0, 1, 0) 開始行 = 1 For i = 1 To 回数 Set シート = Sheets.Add シート.Name = 開始行 & "～" & 開始行 + コピー行 - 1 元.Rows(開始行 & ":" & 開始行 + コピー行 - 1).Copy シート.Range("A1") Columns("A:F").AutoFit 開始行 = 開始行 + コピー行 Next i End Sub
- ベストアンサー
- Excel（エクセル）
- Excel2000VBAで貼り付け先の取得等・・・
シートに行数13、列数不定の表が上下に多数配置されてます。表は上下それぞれ2行の空白行で隔てられています。 各表は連続した列の部分でひとつですが、中には複数の表を横にならべて、途中1列の空白列で間隔をあけたものもあります。 この、複数の表を横に並べたものを上下に配置しなおすため、以下のように書きました。 質問です。 １．Dim ans As Variantは 'variantで正しいですか？ ２．15行（13行＋間隔用2行）挿入にForNext以外にいい方法はないですか？ ３．切り取った部分を貼り付ける際、Set XRng = SelectionでなくセレクトせずにXRngを取得できませんか？ 他に指摘事項があればお願いします。 Sub TEST() Dim ans As Variant Dim Rng As Range, XRng As Range Dim c As Integer, b As Integer, i As Integer, n As Integer, x As Integer ans = MsgBox("分離したい表を選択してある？", vbYesNo + vbQuestion) If ans = vbNo Then Exit Sub Set Rng = Selection b = Application.CountBlank(Range(Rng(2, 1), Rng(2, Rng.Columns.Count))) '分離する数を取得 Set XRng = Rng For i = 1 To b'分離する数だけ繰返し For n = 1 To 15 '行挿入 XRng.Offset(14, 0).Resize(1, 1).EntireRow.Insert Shift:=xlDown Next n c = XRng.Columns.Count '列数取得 x = Range(XRng(1, 1), XRng(1, 1).End(xlToRight)).Columns.Count '最左側部分の列数取得 XRng.Offset(0, x + 1).Resize(13, c - x - 1).Cut '右側カット Rng.Offset(15 * i, 0).Resize(1, 1).Select '貼付け開始位置セレクト ActiveSheet.Paste '貼付け Set XRng = Selection 'XRng再取得 Next i End Sub
- ベストアンサー
- オフィス系ソフト
- Excel vba selectが効かない
2と3の2つのエクセルファイルがあります。縦の列を新しいファイルの横の行に コピーしていきたいプログラムです。 2のファイルの１シート目の"C8:C25" 3のファイルの１シート目の"C9:C65" を新しい1のファイルの１シート目の１行目にコピーするプログラムを 作っていますが１シート目はpasteされるのですが 3のファイル２シート目からselectの指定が"C9:C65"ではなく、B9からQ65の指定になってしまい思ったコピーができません（★のところ）、1シート目はうまくいっているのでどうして3のファイルの2シート目のからうまくいかないかわかりません。 5シートまででテストをしているのですが実際は各々255シートありもってくる列も 12列あります。とりあえずCの列だけ5シートで試してみています。 Dim i As Long Dim N As Long i = 1 N = 1 Do While i <= 5 ''C列''' Workbooks(2).Worksheets(i).Activate '2のファイル Worksheets(i).Range("C8:C25").Select 'もってくるところ Selection.Copy Workbooks(1).Worksheets(1).Activate '1新しいファイル Range("C" & N).Select '貼り付けるところ Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True Workbooks(3).Worksheets(i).Activate '3のファイル Workbooks(3).Worksheets(i).Range("C9:C65").Select '★もってくるところ Selection.Copy Workbooks(1).Worksheets(1).Activate '1新しいファイル Range("U" & N).Select '貼り付けるところ Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True i=i+1 N=N+1 LOOP
- ベストアンサー
- Visual Basic
- エクセルVBAについて
エクセルVBAについて 下記のようなマクロで、選択したセルの、列の背景色の切り替えを行いたいと思っています。 が、写真のように、塗りつぶしを行いたいセルが結合しているところと、 そうでないところがあり、列全体に、うまく塗りつぶしができません。 '列の背景色を変更 Cells.Interior.ColorIndex = xlNone Dim i As Long i = Target.Column Columns(i).Interior.ColorIndex = 6 Columns(i + 1).Interior.ColorIndex = 6 また、選択するセルは、2行目で、2列が結合しています。 うまく、2列が結合しているセルにも、塗りつぶしを適用することは可能でしょうか？ また、できれば列全体の塗りつぶしでなく、行の範囲も指定できればと思っています。 写真では、2列が結合していない部分のみ、塗りつぶしが適用されています。 表の構成上、結合しているセルとそうでないセルの変更ができないため、困っています。 どうぞ、よろしくお願いいたします。
- ベストアンサー
- その他（プログラミング・開発）
- VBA ループ文
お手数ですが、回答お願いします。 ＶＢＡでループ文を勉強しております。 最初のfor 文で１０００行、１０００列に文字を入力、 次のdo 文でその文字を全部消したいのですが、うまくいきません。 またfor 文で１０００行、１０００列で文字を入力しているのですが、 時間がかかるのは仕方がないことなのでしょうか？ お手数ですが、ご教授お願いします。 Sub 文字入力() Dim i As long Dim t As long For i = 1 To 1000 For t = 1 To 1000 Cells(i, t) = "wooo" Next t Next i End Sub ================================================================= Sub 文字入力消し() Dim i As long Dim t As long i = 1 Do t = 1 Do Cells(i, t) = "" t = t + 1 Loop Until Cells(i, t) = "" i = i + 1 Loop Until Cells(i, t) = "" End Sub
- ベストアンサー
- Excel（エクセル）
- その列の結合セルを次のセルにコピーしたい場合
A列目に結合セルがあってその結合セルをB列からE列までコピーするコードを書きたいと思って次のコードを記述しましたが動きません。 どこが間違っているのでしょうか？ sub() Do While Columns(1).MergeArea = True Columns(1).Copy Columns(2) Columns(1).Copy Columns(3) Columns(1).Copy Columns(4) Columns(1).Copy Columns(5) Loop End sub
- ベストアンサー
- その他MS Office製品
- エクセルVBA 別シート間の列のコピー＆ペースト
列のコピー＆ペーストができません。 i, j は変数で、Integerで定義しており、省略はしていますが、期待通りの値がi, j には代入されています。 Sheet1のi列からj列をコピーし、Sheet2のC列（これは固定）に貼り付けたいのですが、うまくいきません。 私の書いたコードは下記の通り。 下記は改行されていますが、実際のVBAでは１行で書かれています。 Worksheets("Sheet1").Range(Columns(i), Columns(j)).Copy Worksheets("Sheet2").Range(Columns("C")) 貼り付け先（Destination）の記述がいけないのでしょうか？ 行き詰っておりますので、どなたかお助けください！
- ベストアンサー
- その他（プログラミング・開発）
- Excel2013VBA列選択の拡大
ExcelVBA2013です。 列の取得でつまづいております。 お手数ですが、ご教授下さい。 下記のコードで選択範囲のコピー貼り付けは出来ていますが、列幅がコピーされていませんでした。 CC3のセルを基準にOffsetとResizeで範囲拡大してコピーしているためだと思います。 CC3の左隣のAX3:CB3はセル結合されています（○月）。（その下の4行目は日付の１～31が入力） 列は、今回はAX3:CC3まで（1月分）取得できればよいです。（可変します） MaxCol = Range("J5").End(xlToRight).Column で列取得できます。 行の位置は、MaxRow = Range("I5").End(xlDown).Row で取得した値です。 それで、列全体を取得しようと、 MaxCol = Columns(MaxCol).Select で最終列は取得できましたが、そこから列選択の拡大ができればと思っています。 現在は、AX3:CC237まで取得コピーして、隣の列に貼り付けで列幅が違う。 希望はAX:CCまでの列を取得選択コピーして貼り付け。 Sub SAMPLE() Dim MaxRow As Variant, MaxCol As Variant Dim r As Range, c As Range MaxRow = Range("I5").End(xlDown).Row '最終行番号 MaxCol = Range("J5").End(xlToRight).Column '最終列番号 Set c = Cells(3, Cells(3, Columns.Count).End(xlToLeft).Column) '表の右上角のセル番地を取得 c.Select c.Offset(0, -31).Resize(MaxRow - 2, 32).Copy c.Offset(0, 1) '表右上から１月分選択範囲拡大してコピー隣の列より貼りつけ End Sub
- ベストアンサー
- Excel（エクセル）
- VBA コピペ Range エラー
いつもありがとうございます。 https://okwave.jp/qa/q9586463.html この質問のコードを自力で実務用に改変中です。 GetShe.Range(Cells(RowCnt, 1), Cells(RowCnt, 2)).Copy PutShe.Cells(PutRowCnt, 1) ↑このコードでRangeメソッドが失敗しましたというエラーが出るのですが、超初心者のため、原因がわかりません。 GetSheシートのRowCnt行の1列目と2列目をコピーして、PutSheシートのPutRowCnt行の1列目に貼り付けしたいです。 ○番目のシート、行という意味です。 お願いします。 Sub msukei6() ' 変数を宣言 Dim GetShe As Worksheet Dim PutShe As Worksheet Dim SheCnt As Long Dim RowCnt As Long Dim ColCnt As Long Dim PutRowCnt As Long Dim x As Long ' このブックに何シートあるか調べる SheCnt = ThisWorkbook.Worksheets.Count ' "集計"シートが抽出先である Set PutShe = ThisWorkbook.Worksheets("集計") PutRowCnt = 9 For SheCnt = 4 To 6 ' コピー元は4シート目～6シート目 Set GetShe = ThisWorkbook.Worksheets(SheCnt) ' 各シートの氏名をカウントする x = WorksheetFunction.CountA(GetShe.Range("b3:b100")) Do For RowCnt = 3 To x + 3 ' コピー元は3行目からコピーする If GetShe.Cells(RowCnt, Worksheets("集計").Cells(4, 2)) <> "" Then PutRowCnt = PutRowCnt + 1 GetShe.Range(Cells(RowCnt, 1), Cells(RowCnt, 2)).Copy PutShe.Cells(PutRowCnt, 1) End If Next RowCnt Exit Do Loop Next SheCnt End Sub
- ベストアンサー
- Excel（エクセル）
- VBAで行を挿入する
VBAを始めた初心者です。 Exel2002使用です。 VBAでA列の4行目から10行目に行の挿入をできるようにしようと下記のように書きましたが、Rows("i:i").Selectの部分でデバックがかかってしまいます。間違っている理由がわからないのですがよろしくお願いします。 また、DO While Loopステートメントを使ってA列が空白になるまで（例えばA4セル以下の）行を挿入とする場合の方法も教えていただけましたら幸いです。 Sub 4行目から10行目まで() Dim i As Integer For i = 4 To 10 Cells(i, 1).Value = i Rows("i:i").Select Selection.Insert Shift:=xlDown Next i End Sub Sub 4行目から空白になるまで() Dim i As Integer Range（"A4").serect Do While activecell.value = "" Cells(i, 1).Value = i Rows("i:i").Select Selection.Insert Shift:=xlDown activecell.offset(1,0).select Loop End Sub
- ベストアンサー
- Visual Basic
お礼
お礼が遅くなり失礼をいたしました、申し訳ございません。 やりたいことができました！大変感謝しております。 わかりやすいご回答いただきありがとうございました。