- 締切済み
エクセルVBAにて、特定文字の前に行を追加したい
こんにちは。 エクセルVBAにて、特定文字が含まれる行の前に空白の行を挿入するマクロはどのように書けばいいでしょうか。 そして、特定文字が連続して入力されている場合、連続した文字の個数と同じ行数を、連続した最初の文字の前に挿入したいと思っています。 特定文字=ラーメン 1行目 うどん 2行目 ラーメン(この上に3行挿入) 3行目 ラーメン 4行目 ラーメン 5行目 うどん 6行目 うどん 7行目 ラーメン(この上に1行挿入) 8行目 うどん 9行目 ラーメン(この上に2行挿入) 10行目 ラーメン 11行目 うどん 下記のようなコードを検索結果を参考に作成しましたが、これだとラーメンの上にすぐ空白の行が挿入されてしまい、連続した最初の特定文字の上にまとめて挿入する事ができません。 Sub Test() Dim a As Range Dim j As Long, k As Long j = WorksheetFunction.CountIf(Columns(3), "ラーメン") Set a = Range("C1") Do Set a = Columns(3).Find(What:="ラーメン" _ , After:=a _ , LookIn:=xlValues _ , LookAt:=xlWhole _ , SearchDirection:=xlPrevious) If Not a Is Nothing Then k = k + 1 a.EntireRow.Insert End If Loop While k < j End Sub どうすればいいかご教授お願いいたします。
- みんなの回答 (7)
- 専門家の回答
みんなの回答
- real beatin(@realbeatin)
- ベストアンサー率82% (174/211)
関連するQ&A
- VBA 特定の文字列を含む行を削除する方法
特定の文字列を含む行を削除する方法が知りたいです。 行を削除する方法はWebで見つけたのですが↓ ---------------------------------------------------- Sub 特定の文字列を含む行を削除() Dim c As Range Dim myRow As Long With Range("A:A") Set c = .Find("特定の文字列") Do While Not c Is Nothing Rows(c.Row).Delete shift:=xlUp Set c = .Find("特定の文字列") Loop End With End Sub ---------------------------------------------------- ↑行を指定している箇所のRowsを Columns RowをColomn に変更して以下の様にしてみました、 Columns(Colomn,c).Delete shift:=xlUp だめでした、、、。 VBAの知識が乏しく、組み立て方について理解が無いため、どうすればよいかさっぱりわからず、、 こちらで質問させて頂きました。。。 何卒宜しくお願い致します。
- ベストアンサー
- オフィス系ソフト
- EXCEL VBA4行毎に枠で囲みたい
お世話になります。 添付の様な表1があります。 これを表2のようにA1から順に4行毎に枠で囲みたいのです。 下記のようなコードを見よう見まねで書いてみましたがうまく動きません。 ごなたかご教授いただけませんでしょうか? よろしくお願い致します。 Dim i As Long Dim j As Long Dim lngYCnt As Long Dim intXCnt As Long Dim LastRow As Long ingYCnt = Worksheets("Sheet1").UsedRange.Rows.Count intXCnt = Worksheets("Sheet1").UsedRange.Columns.Count LastRow = Cells(Rows.Count, 1).End(xlUp).Row With Selection For i = 5 To LastRow Range("A" & i & ":F" & j).Select Selection.BorderAround Weight:=xlMedium j = j + 5 i = i + 5 Next End With どなたかご教授いただけませんでしょうか? よろしくお願い致します。 環境 EXCEL2003 WINDOWS XP SP3
- ベストアンサー
- その他MS Office製品
- エクセルのVBAで行選択
エクセルVBAで、連続してない2行(たとえば10行目と13行目)を選択する場合 Sub test02() Dim x As Long, y As Long x = 10 y = 13 Range(x & ":" & x & "," & y & ":" & y).Select End Sub でできましたが、もっと簡単に書く方法はないでしょうか?
- ベストアンサー
- Excel(エクセル)
- VBA 複数の行を挿入後、挿入以外を削除
知恵をお借りください。 A10に5行分挿入、A13に2行分挿入、A14に1行分挿入、A16に2行分挿入 以下がコードです。 Dim n As Long n = Worksheets("Sheet1").Range("A1").Value With Worksheets("Sheet2") .Range("A10").Resize(n).EntireRow.Insert .Range("A10").Resize(n).EntireRow.Interior.Color = vbYellow .Activate End With Dim k As Long k = Worksheets("Sheet1").Range("A2").Value With Worksheets("Sheet2") .Range("A13").Resize(n).EntireRow.Insert .Range("A13").Resize(n).EntireRow.Interior.Color = vbRed .Activate End With Dim m As Long m = Worksheets("Sheet1").Range("A5").Value With Worksheets("Sheet2") .Range("A14").Resize(n).EntireRow.Insert .Range("A14").Resize(n).EntireRow.Interior.Color = vbGreen .Activate End With Dim ka As Long ka = Worksheets("Sheet1").Range("A10").Value With Worksheets("Sheet2") .Range("A16").Resize(n).EntireRow.Insert .Range("A16").Resize(n).EntireRow.Interior.Color = vbBlue .Activate End With マクロ実行後、行の並び方がバラバラになっています。 ↓イメージ図 https://mega.nz/#!yUwXHTLK!TSZvMJ1CaiTi-OoX-1j9IeNleuXesrzU5O7o2vG-svI 理想図に整えるにはどうすれば良いのでしょうか? また、マクロで行を挿入したら、不要な行を削除するコードも教えてくださればありがたいです。 ↓イメージ図 https://mega.nz/#!fMRDAKAJ!GHMpiagpn-O_0aaMhrHOozFd8WHHkSQzOS-fSCInw-g 宜しくお願いします。
- ベストアンサー
- Visual Basic
- エクセルVBA抽出がうまく出来ません
エクセル2013VBA初心者です。 入力シートからDBシートへ、DBシートから印刷シートへのデータ転記と印刷、入力内容のクリアまでは出来るようになりました。 DBシートの検索を行い、記録内容を入力シートに転記する抽出を行いたいのですが、下記構文を書いたところで問題が発生しました。 If Sh2.Range("A & i").Value = j And Sh2.Range("B & i").Value = k Then でとまります。メッセージは ‘Range’メソッドは失敗しました:‘Workshieet’オブジェクトというものです。 やろうとしていることは、入力シートに設けた“E12”と”G12”の二つの検索項目をキーにDBシートの行を特定し、この行の内容を入力シートに反映しようということです。 入力シートの検索項目“E12”、 ”G12”はそれぞれDBシートのA列、B列に格納されている項目で、年度と連番です。サンプルとして入力シート"C5"に抽出しようとしているDBシートD列は申請者名です。 恐れ入りますがよろしくご教示頂きたく、お願い申し上げます。 Sub DBシートから力情報を抽出する () Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim i As Long Dim j As Long Dim k As Long Set Sh1 = Worksheets("入力") Set Sh2 = Worksheets("DB") j = Sh1.Range("E12").Value k = Sh1.Range("G12").Value With Sh2 For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row If Sh2.Range("A & i").Value = j And Sh2.Range("B & i").Value = k Then Sh1.Range("C5").Value = Sh2.Range("D & i").Value End If Next End With End Sub
- ベストアンサー
- Excel(エクセル)
- エクセルVBA カウンタ2つを入れ子にしたくない時
皆さんこんにちは。 エクセル2013を使用しております。 エクセルVBAの繰り返し処理について質問させていただきます。 下記のコードですと入れ子があるので A1にi、A3にi・・・・を一通り記載したあと またA1にi+2、A3にi+2・・・を繰り返し 最終的にA列には全て同じ値が入ってしまいます。 (Step 2にしたのはA1:A2のように2行毎の結合セルだからです) ----------------------------------------------------------------- Dim i As Long Dim j As long Dim n As long Dim k As long i =Userform.textbox1.value j =Userform.textbox2.value For k =i To j Step 2 For n = 1 to j Step 2 Range("A" & n) = k Range(”B”&n)=k+1 Next Next ---------------------------------------------------------- もしiが1、jが10だとしたら A1に1、B1に2、A3に3、B3に4、・・・A9に9、B9に10 が入るようにするにはどうしたら良いでしょうか。 iが必ず1から始まるのであればまだ分かるのですが そうとも限らないので カウンタはやはり2つ必要だと思うのですが カウンタが2つあるのに入れ子にしないコードの書き方って あるのでしょうか。 いくら本やネットを見ても分かりません。 ご教授いただけると幸いです。
- ベストアンサー
- Excel(エクセル)
- エクセル 最終行からの連続コピー
エクセルで最終行から上に連続する10行(最終行含む)をコピーしたいです。 途中、空白行が含まれている場合でも、最終行を特定し、コピーできるようにするには、下記のコードにどう手を加えたらよいでしょうか? どなたかアドバイスをお願いします。 Sub Test() Dim i As Long Dim j As Integer Dim rng As Range With ActiveSheet 'フィルタ .Range("A1").CurrentRegion.AutoFilter Field:=1 '行選択 With .AutoFilter.Range For i = .Cells(.Cells.Count).Row To 2 Step -1 If .Rows(i).Hidden = False Then If rng Is Nothing Then Set rng = .Rows(i) Else Set rng = Union(rng, .Rows(i)) End If j = j + 1 End If If j >= 10 Then Exit For Next i 'コピー If Not rng Is Nothing Then rng.Copy Worksheets("Sheet2").Range("A1") Beep Else MsgBox "該当行は存在しません。", 48 End If End With End With Set rng = Nothing なお、コードはこちらを参考にさせていただきました。 http://okwave.jp/qa3552420.html?ans_count_asc=1
- 締切済み
- その他MS Office製品
- エクセルVBA FindNextについて
エクセル2002使用です。 VBAのFindNextメソッドについて教えていただけますでようか?不定期の行ごとに存在する○から△までの表を抽出するために次のようなコードをつくりました。 A B C D 1 ○ × × 2 × × × 3 △ × × 4 5 ○ × × 6 × × × 7 △ × × Sub 表の抜き出し() Dim myr1 as range Dim myr2 as range Dim firstmyr1 as String Set myr1 = Columns("A").Find(What:="○") firstmyr1 =myr1.adress Set myr2 = Columns("A").Find(What:="△") Do 処理・・・・ Set myr1 = Columns("A").FindNext(after:=myr1) Set myr2 = Columns("A").FindNext(after:=myr2) Loop until myr1.adress = firstmyr1 End Sub 上記のようなコードで、処理の後のSetステートメントでFindNextを使うと、A5の○とA7の△を見つけてほしいのに、1回目の処理・・・の後の読み込みでウオッチで見るとmyr1値が△になってしまって2回目の読み込みにいけません。Setステートメントが2つ以上あるときのFindNextメソッドの使い方で何か注意点があるのでしょうか? よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで列幅設定
A列の幅を、C~F列の幅(同一ではありません)に設定しようと思いました。 ところが Columns("A").ColumnWidth = Range("C1:F1").Width とすると、ColumnWidthとWidthの単位がまったく違うのでエラーになります。 同じ単位で設定するには Columns("A").ColumnWidth = Columns("C").ColumnWidth + Columns("D").ColumnWidth + Columns("E").ColumnWidth + Columns("F").ColumnWidth とするか、 Sub test02() Dim c As Range Dim x As Single For Each c In Range("C1:F1") x = x + c.ColumnWidth Next Columns("A").ColumnWidth = x End Sub などのように手の込んだことをするしか思いつきません。 もっと簡単な方法はないでしょうか?
- ベストアンサー
- Excel(エクセル)
- EXCEL(VBA)で1行おきに行を選択する方法
こんにちは。VBAは苦手なので教えてください。 EXCELのsheet1にあるリストに、下記マクロで1行おきに 空白行を挿入しました。 Sub test1() '隔行で空白行を挿入 Dim rw As Long 'セル For rw = Range("A1").End(xlDown).Row To 2 Step -1 Rows(rw).Insert Next End Sub 同じファイルのSheet2の1行目<Rows("1:1")>に、計算式が入力されています。 マクロで挿入した空白行全てを選択し、そこへSheet2の1行目のコピーを 貼り付けたいです。 ぜひ、良い方法を教えてください。
- ベストアンサー
- オフィス系ソフト