コラムH、K、Oすべてに値が入っている該当行をもう一行挿入するというものです。【例】３行目のコラムH（H3）、K（K3） 、O（O3）すべてに値が入っていた場合は３行目をコピーし、４行目として挿入したいです。その際、本来４行目に入っていた行は５行目へとシフトします。
是非お力添えを頂ければと思います。
No.2
22
5
500pt
こんな感じでいいですか？
（そのまま使用できる状態を回答するのは、勉強する機会を奪うようで、あまり良くないのかもしれませんが･･･）
14
13
Public Sub Check_H_K_O_and_CopyRow()
On Error GoTo Check_H_K_O_and_CopyRow_Error
Dim i As Double
For i = 1 To 65535
'H,K,Oのいずれかが「空」ならTHEN、それ以外はELSEへ
If IsEmpty(Range("H" & CStr(i)).Value) Or _
IsEmpty(Range("K" & CStr(i)).Value) Or _
IsEmpty(Range("O" & CStr(i)).Value) _
Then
'H,K,Oが全て「空」であれば、終了
If IsEmpty(Range("H" & CStr(i)).Value) And _
IsEmpty(Range("K" & CStr(i)).Value) And _
IsEmpty(Range("O" & CStr(i)).Value) _
Then
Exit For
End If
Else
'行コピー＆行挿入貼付け
Rows(i).Copy
i = i + 1
Rows(i).Insert Shift:=xlDown
End If
Next i
Application.CutCopyMode = False
Range("A1").Select
MsgBox "Finished"
Exit Sub
Check_H_K_O_and_CopyRow_Error:
MsgBox "!! Error !!" & vbCr & vbCr & Err.Description
End Sub
・Excelシートの１行目から処理しています。
・Ｈ，Ｋ，Ｏのセルが全て「空」の行で終了します。
＜Excel VBA 入門講座＞
No.1
135391198
20pt
If Cells(3, "H") <> "" And Cells(3, "K") <> "" And Cells(3, "O") <> "" Then
Rows("3:3").Copy
Rows("3:3").Insert Shift:=xlDown
End If
こういう感じになります。
もし 複数回 行うならば、一番下の行から やってくのが 原則となります。
takntさん、
ありがとうございます。
今回はシート全体で行いたかったので、少し目的とずれがありました。
No.2
225
ここでベストアンサー
500pt
こんな感じでいいですか？
（そのまま使用できる状態を回答するのは、勉強する機会を奪うようで、あまり良くないのかもしれませんが･･･）
Public Sub Check_H_K_O_and_CopyRow()
On Error GoTo Check_H_K_O_and_CopyRow_Error
Dim i As Double
For i = 1 To 65535
'H,K,Oのいずれかが「空」ならTHEN、それ以外はELSEへ
If IsEmpty(Range("H" & CStr(i)).Value) Or _
IsEmpty(Range("K" & CStr(i)).Value) Or _
IsEmpty(Range("O" & CStr(i)).Value) _
Then
'H,K,Oが全て「空」であれば、終了
If IsEmpty(Range("H" & CStr(i)).Value) And _
IsEmpty(Range("K" & CStr(i)).Value) And _
IsEmpty(Range("O" & CStr(i)).Value) _
Then
Exit For
End If
Else
'行コピー＆行挿入貼付け
Rows(i).Copy
i = i + 1
Rows(i).Insert Shift:=xlDown
End If
Next i
Application.CutCopyMode = False
Range("A1").Select
MsgBox "Finished"
Exit Sub
Check_H_K_O_and_CopyRow_Error:
MsgBox "!! Error !!" & vbCr & vbCr & Err.Description
End Sub
・Excelシートの１行目から処理しています。
・Ｈ，Ｋ，Ｏのセルが全て「空」の行で終了します。
＜Excel VBA 入門講座＞
Ktwoさん、
ご迅速なご回答、誠にありがとうございました！
確認させていただきました。
No.3
18071
100pt
その様な行が連続するケースの処理方法や、チェックするカラムをその度毎に変更する必要性等
いろいろ不明な点がありますので、これがベストのものとは言い難いですが、一応このマクロで
仰せの様なことは実現できていると思います。定数RowStartとRowEndには、チェックを行なう
行の範囲(各々最初と最後の行番号)を指定して下さい。
Option Explicit
Sub Hatena_TororoSoba_100928()
Const RowStart As Integer = 1
Const RowEnd As Integer = 100
Dim Count1 As Integer
For Count1 = RowStart To RowEnd
' カラムH,K,Oはそれぞれ8,11,15番目のカラムです。
If Application.CountA(Cells(Count1, 8), Cells(Count1, 11), Cells(Count1, 15)) = 3 Then
With Rows(Count1)
.Copy
.Insert Shift:=xlDown
End With
Count1 = Count1 + 1
End If
Next
End Sub
Silvanusさん、
ありがとうございました。
確認させていただきました！
No.4
45529
100pt
Excel2003としてお答えします。
即興で作ったので構文が汚くてすみません。
以下、マクロになります。
Sub Macro1()
i = 1
Do
If Cells(i, "H") <> "" And Cells(i, "K") <> "" And Cells(i, "O") <> "" Then
Rows(i).Select
Selection.Copy
Rows(i + 1).Select
Selection.Insert Shift:=xlDown
i = i + 1
End If
i = i + 1
Loop Until i > 65535
Application.CutCopyMode = False
Range("A1").Select
End Sub
上記まで
URLはダミーです。
spyglassさん
ありがとうございました。
確認させていただきました！
No.5
21649
100pt
1シートの1行目から最終使用行までのチェックです。
URLが必要なのですね。
最終行の行番号の取得は
http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_030_100.html
Sub test()
myr1 = 1
myr2 = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
For i = myr2 To myr1 Step -1
If Cells(i, "H") <> "" And Cells(i, "K") <> "" And Cells(i, "O") <> "" Then
Rows(i + 1).Insert shift:=xlDown
Rows(i).Copy Destination:=Rows(i + 1)
End If
Next i
End Sub
hathiさん、
ありがとうございました！
確認させていただきました！
Ktwo
2010/09/28 23:16:06
1
1
Ktwoさん、
ご迅速なご回答、誠にありがとうございました！
確認させていただきました。