- ベストアンサー
エクセル2002のVBAで、一グループごとにセルを追加する方法
xdaixの回答
1行目が赤文字で、空白のセルがきたら終わりで良ければ Option Explicit Sub Test() Dim i As Long Dim j As Integer '1行目は必ず赤文字と仮定して2行目から i = 2: j = 2 Do Until Cells(i, 1).Value = "" If Cells(i, 1).Font.ColorIndex = 3 Then Do Until j >= 6 Cells(i, 1).Insert Shift:=xlDown i = i + 1: j = j + 1 Loop j = 0 End If i = i + 1: j = j + 1 Loop End Sub
関連するQ&A
- 空白セルと０値を識別させたい。（VBA）
すみません、誰か教えていただけますか。 シートの53、54、55行目にそれぞれ値入っています。 それを３行目にビジュアル的に表現させています。 55行目はセルの色で、53行目は数値があり同じ値が 続く部分の合計を出しています。 しかし、下記の記述ですと数値が0（変数D=0）の時に うまくいきません。空白セルと認識されてしまうと思います。 何か、良い方法があれば教えて頂けませんでしょうか。 宜しくお願いします。 Sub 表示() Dim a As Long Dim c As Long Dim D As Long Dim e As String Dim f As String c = 3 For a = 3 To 64 With Worksheets("Sheet1") If .Cells(53, a) <> .Cells(53, a + 1) Then .Range(.Cells(53, c), .Cells(53, a)).Select D = WorksheetFunction.Sum(Selection) e = D f = Selection(1).Offset(1, 0).Value G = Selection(1).Offset(2, 0).Value If D <> 0 Then Selection(1).Offset(-50, 0).Value = f + "//" + e .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.Interior.ColorIndex = G End If If Selection(1).Value = "" Then .Range(.Cells(53, c), .Cells(53, a)).Offset(-50, 0).Select Selection.ClearContents Selection.Interior.ColorIndex = xlNone End If c = a + 1 End If End With Next End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルマクロ 【空白セルを無視する方法を教えてください】
マクロを独学で学び仕事に応用しているのですが、どうしても分からないことが発生してしまい、質問です。 内容は、今、エクセルシートのA1～B5の範囲で A B 1 1 1 2 1 2 3 4 1 5 1 という形で入力されています(見難くてスミマセン)。 この状態から「A列とB列に同じ数字が入力されてれば、メッセージBOXを表示して、なおかつOKボタンを押したら該当セルを赤くする」というマクロを作りたいのですが、本来であれば1行目のみ赤くなるはずなのですが、空白セルが含まれている3行目も赤くなってしまうんです。つまり、空白セルも「同じ値」と認識されているみたいなのですが...。 この場合、空白セルを無視するにはどうしたらよいのですか？教えてください。なお、マクロは以下のように作っています。 Sub ナンバーチェック() Dim Btn As Integer For X = 5 To 10 If Cells(X, "A").Value = Cells(X, "B").Value Then Btn = MsgBox("同じ数値です", vbOK, "警告") If Btn = vbOK Then Cells(X, "A").Interior.ColorIndex = 3 Cells(X, "B").Interior.ColorIndex = 3 End If End If Next End Sub
- ベストアンサー
- オフィス系ソフト
- 空白セルがある行の左寄せ操作の件
下記のようにＩ列に空白セルを検出し、その空白セルがある行においてＩ列からＭ列までのデータを左寄せする処理行っております。 For 番号 = 1 To Range("B1").End(xlDown).Row If Cells(番号, 9).Value = "" Then コピー開始列 = Cells(番号, 9).End(xlToRight).Column Range(Cells(番号, コピー開始列), Cells(番号,13)).Select Selection.Cut Destination:=Range(Cells(番号, 9),Cells(番号, 9 + 14 - コピー開始列)) Range(Cells(番号, コピー開始列), Cells(番号,13)).Select End If Next 番号 対象行数が３０００行ほどあり処理時間がかかりすぎるため、もう少し効率よいやり方があれば教えてください。
- ベストアンサー
- オフィス系ソフト
- いい方法を教えてください（VBAについての質問）
よろしくお願いします。 ある処理についてプロシージャを作成しました。 それは「毎回データの行数・列数の異なるデータから必要な列のデータだけを取り出して別のシートにコピーして貼り付ける」処理です。 具体的にはセルのA2以下にデータを貼り付けて必要な列の1行目空白セルに1を、不要な列は0を入れ、必要なデータ（1を入れた列にあるデータ）だけ取り出すという処理です。 Do Until ActiveCell.Value = "" If Selection.Value = "1" Then Selection.Offset(1, 0).Select Range(Selection, Selection.End(xlDown)).Copy _ Destination:=mySht.Range("IV1").End(xlToLeft).Offset(0, 1) Selection.End(xlUp).Offset(0, 1).Select Else Selection.Offset(0, 1).Select End If Loop ↑こんな感じで書きました。 myShtは変数で、必要データ貼り付け用に作成したシートです。 使ってみて穴に気付きました。 データに空白があった時に、空白以後のデータがコピーされないのです。そういう書き方なので当然ですが・・・。 範囲の指定をその列のデータの最初から空白関係なくデータのある最終行までにしようとあれこれと試しましたがことごとくうまくいきません。 これが1つ目の悩みです。 もう1つは Range(Selection, Selection.End(xlDown)).Copy _ Destination:=mySht.Range("IV1").End(xlToLeft).Offset(0, 1) の部分、取り出した列のコピーを別のシート（mySht）に左寄せで順番に詰めてコピーしていくようにしたのですが、この記述だと1列目が空いてしまいます。 ですから実際はこの後1列目を削除する処理をしています。 この1列目の削除というのが本来不要な作業なので、なんだかイヤなのです。 何かいい方法を教えてください。 ヒントみたいなものでもうれしいです。
- ベストアンサー
- オフィス系ソフト
- 指定したセルの下へ行を追加する
エクセルのＶＢＡを作成しています。 １．検索して一致した内容の隣（Ｂ列)のセルに色がつく２．色のついたセルの下へ1行空白行を追加する をしたいと思い、 With Sheets(1) If Not hkR Is Nothing Then Set myR = Intersect(hkR.EntireRow, .Columns(2)) If Not myR Is Nothing Then myR.Interior.ColorIndex = 18 myR.Offset(1).EntireRow.Insert , shift:=xlDown Application.CutCopyMode = False End If End If End With Set myR = Nothing Set scR = Nothing Set ckR = Nothing Set hkR = Nothing End Sub 上記コードの、 myR.Offset(1).EntireRow.Insert , shift:=xlDown Application.CutCopyMode = False の部分が違うと思うのですが、 色のついたセルが２つ３つとつながって存在した場合 （２行目３行目４行目と言った感じに） ２行目の下にまとめて空白行が３行追加されてしまいます。 ↓ ２行目 空白行 ３行目 空白行 ４行目 空白行 としたいのですが、どのように直したらよいのかわかりません。申し訳ありませんがよろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルのVBA
AB列に複数行データがありB列の条件でその行のABのデータ を抽出し特定の場所に貼り付けたいのですが貼付け場所が 任意に選択できません。今はデータの無いA列から貼り付けていますが できればD列の1行目か2行目から貼り付ける方法を教えてください。 また今のコードでは貼付けたいデータの順番が下のデータからになってしまいます。 これも元のデータ順にしたいのでよろしくお願いします。 今使っているコードは下記の通りです。 For i = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1 If Cells(u, 2) < "96" And Cells(u, 2) <> "0" And Cells(u, 2) <> " " Then Range(Cells(u, 1), Cells(u, 2)).Select Selection.Copy Range("A1").End(xlDown).Offset(1, 0).Activate Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next
- ベストアンサー
- オフィス系ソフト
- エクセルＶＢＡで範囲の指定をしたいです（初心者）
エクセルＶＢＡで範囲の指定をしたいです（初心者） 列ＡからＪがデータが入る範囲です。 列ＡとＢとＣには必ず数値等が何かしら入ります。 列Ｄは常に空白です。 列Ｅ以降は何か入ることも入らないこともあります。 ７行目までデータがある場合、 Ａ１セルからこの場合はＪ７セルまでを範囲指定したいのですが 行数は未定なので、 Range("A1").Select Range(Selection,Selection.End(xlDown)).Select でＡ列のデータ最終行まで下がり、そこから９つ右の列までを 範囲指定するというのがよくわかりません。 自動記録で絶対参照と相対参照を切り替えてやってみたのですが、 どうしても Range(Selection, Selection.End(xlDown)).Select ActiveCell.Range("A1:J7").Select と常にＡ１からＪ７が指定になってしまいます。 バージョンは2003です。 つたない質問文で申し訳ありませんが、 どなたか宜しくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- Excel2003でのVBA
WindowsXPでExcel2003を使っています。 Excelにある表をマクロを使って編集したいと思ったのですが、セルの選択の設定で教えてほしい事があります。 まず、横A列～F列、縦1行～6行までの表があります。 A1セルは、空白。 B1セル～F1セルには、1～5の数字が入っています。(見出しなので全て入ってます。) A2セル～A6セルには、a～eのアルファベットが入っています。(見出しなので全て入ってます。) 表の中のデータは、ところどころにしか入っていなくて、全て埋まっていません。 また、横A列～F列というのは固定なのですが、縦1行～6行までという行数は変動します。 この表で、A2セルからF6セルまでを選択したいのですが、行が変動するのでA6とかF6とかでは指定できません。 Range("A2").Select Selection.End(xlDown).Select これで、A2セル～一番下の行(ここではA6セル)まで選択した後、F列まで(列の数は固定です。)選択するにはどうしたらよいのでしょうか? 右下のセルは、空白なので困っています。 Range(Selection, Selection.Next).Select こんなものを考えましたが、これでは一つ右隣しか選択できません。 これを少しいじればいいのではないかと思うのですが、全然違う方法でもかまいません。 どなたか教えていただけないでしょうか? 宜しくお願いします。
- ベストアンサー
- Visual Basic
- エクセルでデータがある部分だけ範囲内の空白も込みで罫線で囲いたいです。
エクセルでデータがある部分だけ範囲内の空白も込みで罫線で囲いたいです。 再質問です。 エクセルのファイルを開いて、データのある部分だけを罫線で囲みたいです。 データーは常に列数も行数も違います。 また空白の行があったり、列があったり一部のセルが空白だったり。 ここで教えてもらった記述があるのですがその時の質問は （データのある部分だけ囲みたい）としたので、それに対応した記述の為 例えば A1からM1まではデータがあり、 A2からM2までは空白 A3からM3まではデータがある場合とか A1からM100までぎっしり埋まっている場合で E列はE1からE100まで空白とか、 A1からM100までぎっしり埋まっている場合で セルB5、C8、D12、E13だけは空白だと 空白部分は囲ってくれません。 又は A1からM1まではデータがあり、 A2からM2までは空白 A3からM100まではデータがある場合とかだとA1からM1だけ囲まれますが A2からM100までは囲まれません。 これはある意味（データーのある部分だけ）と質問したので仕方有りません。 自分でやるとマクロの記録しかできず以下のようになってしまいます。 これですと上記例でデータはA1からM100までで 3行目がなかったり、Ｄ列がなかったり、所々のセルに空白が 有りますが、罫線で囲うのはあくまでA1からM100までなのですが 以下の記述ではシート全てが罫線で囲まれてしまいます。 また対象のファイルは行数や列数が決まっているわけではないのです。 （100行かもしれないし1,000行かも知れない、Ｃ列までかも知れないし Ｚ列までかもしれません。 1から10行までデータがあって100行空白で101行目からまたデータというほど の空白があるわけでもありません。） どうすれば途中に空白があるデータの先頭から最後だけを囲えるのでしょうか？ 空白も対象だとしてしまうとデーターの終わりがわからないから、 シート全部を囲うしかないのでしょうか？ Sub Macro1() Cells.Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Range("A1").Select End Sub
- ベストアンサー
- オフィス系ソフト
- エクセル2003 VBAマクロにて 背景色 白色の抽出
エクセル２００３のマクロでセル背景色にて抽出したいのですが 背景色が白色（空白）の抽出ができません。 背景色別に 他セルに文字を自動記入したいのですが、 背景色が白（collorindex=0)の認識をしてくれません。 カラーインデックスでは、白は「0」か「2」になっているので その値でマクロを組んでも認識してくれないようです。 どのようにすればよいのでしょうか？ 以下に私（素人）のマクロ文（一部）です。ご指摘お願い致します。 Dim 行番号 As Integer 行番号 = 7 Do Until Cells(行番号, 1).Value = "" If Cells(行番号, 9).Interior.ColorIndex = 5 Then Cells(行番号, 14).Value = "3号機" ElseIf Cells(行番号, 9).Interior.ColorIndex = 7 Then Cells(行番号, 14).Value = "4号機" ElseIf Cells(行番号, 9).Interior.ColorIndex = 0 Then Cells(行番号, 14).Value = "未加工" End If 行番号 = 行番号 + 1 Loop
- ベストアンサー
- Visual Basic
お礼
御礼が申し訳ありません。うっかり投稿したことを忘れてしまっていました。 アドバイスどおりにできました。お蔭様で作業が大変はかどります。 本当にありがとうございました。