電子書籍の厳選無料作品が豊富!

VBA初心者です。Excel2007、XPを使用しています。

A列からQ列、平均100行程度の顧客データがあります。

F列に型番(アルファベット+数字等)が記入されており、
その型番内に「半角もしくは全角スペース」が含まれている場合、
該当があった行の下へ、該当行をコピーした内容を追加したいです。

できれば、スペースがある数だけ挿入し、
かつ該当行、挿入行に色付け出来ればなお良いです。

ご教授頂けないでしょうか。
宜しくお願い致します。

A 回答 (3件)

たびたびごめんなさい。



No.2のコードで無駄な行がありました。
↓のコードに変更してください。

Sub Sample3()
Dim i As Long, k As Long, str As String
For i = Cells(Rows.Count, "F").End(xlUp).Row To 2 Step -1
If InStr(Cells(i, "F"), "×") > 0 Then
Cells(i, "A").Resize(, 17).Interior.ColorIndex = 36
str = Replace(Cells(i, "F"), "×", "")
k = Len(Cells(i, "F")) - Len(str)
If k > 1 Then
Rows(i + 1 & ":" & i + k - 1).Insert
Cells(i, "A").Resize(, 17).Copy Cells(i + 1, "A").Resize(k - 1, 17)
End If
End If
Next i
End Sub

何度も失礼しました。m(_ _)m
    • good
    • 0
この回答へのお礼

tom04様、ありがとうございます!

今回もイメージ通りの完璧なマクロでした。

内容はなんとなくでしか理解できませんが、
これから頑張って精進します。

本当に助かりました!

お礼日時:2013/11/21 19:52

No.1です。



>F列内に「×」が1つのみなら、該当行を色付けのみ
>「×」が2つなら、1行挿入で色付け、
>「×」が3つなら、2行挿入で色付け

「×」の個数より1行少なく挿入し、コピー&ペーストすればよい訳ですね?
該当行にも色がつくようにしています。
結局、「×」がある行はすべて色がついてしまいますが・・・

前回同様、1行目はタイトル行でデータは2行目以降にあるとします。

Sub Sample2()
Dim i As Long, k As Long, str As String
For i = Cells(Rows.Count, "F").End(xlUp).Row To 2 Step -1
If InStr(Cells(i, "F"), "×") > 0 Then
Cells(i, "A").Resize(, 17).Interior.ColorIndex = 36
str = Replace(Cells(i, "F"), "×", "")
k = Len(Cells(i, "F")) - Len(str)
If k > 1 Then
Rows(i + 1 & ":" & i + k - 1).Insert
Cells(i, "A").Resize(, 17).Copy Cells(i + 1, "A").Resize(k - 1, 17)
Range(Cells(i + 1, "A"), Cells(i + k - 1, "Q")).Interior.ColorIndex = 36
End If
End If
Next i
End Sub

こんな感じではどうでしょうか?m(_ _)m
    • good
    • 0

こんばんは!


検索するのはF列だけで良いのですよね?

F列文字列のスペースの数だけ行を挿入・挿入した行を薄い黄色にしてみました。

Sub Sample1()
Dim i As Long, k As Long, str As String
For i = Cells(Rows.Count, "F").End(xlUp).Row To 2 Step -1
str = Replace(StrConv(Cells(i, "F"), vbNarrow), " ", "")
k = Len(Cells(i, "F")) - Len(str)
If k > 0 Then
Cells(i, "A").Resize(, 17).Interior.ColorIndex = 36 '←薄い黄色
Rows(i + 1 & ":" & i + k).Insert
Cells(i, "A").Resize(, 17).Copy Cells(i + 1, "A").Resize(k, 17)
End If
Next i
End Sub

※ 文字列の最初・途中・最後のスペースすべてが対象となります。

こんな感じをお望みだったのでしょうか?m(_ _)m
    • good
    • 0
この回答へのお礼

tom04様、早々にありがとうございます!
イメージ通りで完璧でした。

申し訳ないですが、
別のパターンで作成頂くことは可能でしょうか。

F列内に「×」が1つのみなら、該当行を色付けのみ
「×」が2つなら、1行挿入で色付け、
「×」が3つなら、2行挿入で色付け、
・・・最大「×」が5つで4行まで

作って頂いたもので出来ないか考えましたが、
私にはどうしても手に負えません。

何卒宜しくお願い致します。

お礼日時:2013/11/21 09:43

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています