VBAでセルを解除して「OK」と入れる方法

前へ 次へ
このQ&Aのポイント
  • VBAを使用して、コピーしたA列の結合セルを解除し、解除した行にすべて「OK」と入れる方法についてアドバイスをお願いします。
  • WorksheetsオブジェクトとCellsオブジェクトを使用して、A列の結合セルを解除し、解除した行に「OK」と入れる方法についてアドバイスをお願いします。
  • VBAのUnMergeメソッドを使用して、A列の結合セルを解除し、解除した行に「OK」と入れる方法についてアドバイスをお願いします。
回答を見る
  • ベストアンサー

VBA - セル解除

コピーA列結合セルを解除して、解除した行にすべてに「OK」と入れたいのですがうまくいきません。 アドバイスをお願い致します。 Dim i, Addr Worksheets("Sheet1").Range("A:A").Copy With Worksheets("Sheet2") .Range("A1").PasteSpecial . . If .Cells(i, 1).MergeCells Then Addr = .Cells(i, 1).MergeArea.Address .Cells(i, 1).UnMerge .Cells(i, 1)(Addr) = "OK" '←ここがダメです。 End If . .

noname#187796
noname#187796

質問者が選んだベストアンサー

  • ベストアンサー
  • kybo
  • ベストアンサー率53% (349/647)
回答No.1

Addr = .Cells(i, 1).MergeArea.Address でA1:C10とかアドレスを取得しているので、以下の様にRange(Addr) として下さい。 Range(Addr) = "OK"

noname#187796
質問者

補足

ありがとうございました。 解決しませんでした。 複数行のセルですが、先頭行にだけ"OK"がコピーされていました。 他に見直すところはございますか?

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • 結合セル解除

    補足情報の追加書き込みがわかりませんので何度もトビを起こしいます。 申し訳ございません。 ↓例で、 G列結合セルを解除して、解除した行にすべてに"●"と入れたいのですがコピーできません。。 ご意見をいただけませんか? ------------ Option Explicit Sub Sample() Dim nRow, i, Addr, tmp Worksheets("Sheet1").Range("D:E,K:K,V:Y,AF:AM").Copy With Worksheets("sheet2") 'Y列も"sheet2"にコピー（G列） .Range("A1").PasteSpecial Paste:=xlPasteValues nRow = .Cells(Rows.Count, 1).End(xlUp).Row 'データのある最終行 For i = 5 To nRow If .Cells(i, 2) = "" Then .Cells(i, 2) = .Cells(i - 1, 2) 'B列 If .Cells(i, 4) = "" Then .Cells(i, 4) = .Cells(i - 1, 4) 'D列 Next i 'Y列（"sheet2"のG列）のデータ分行を追加 For i = nRow To 4 Step -1 'Y列（"sheet2"のG列）にデータがあるか If .Cells(i, 7) <> "" Then tmp = .Cells(i, 7) '-------------ここがうまくいきません。 'G列結合セルを解除して対象行にすべて「OK」と入れる。 If .Cells(i, 7).MergeCells Then Addr = .Cells(i, 7).MergeArea.Address .Cells(i, 7).UnMerge .Range(Addr) = "●" End If '------------ここがうまくいきません。 .Rows(i).Copy .Rows(i).Insert .Cells(i + 1, 3) = "-" .Cells(i + 1, 6) = tmp '.Cells(i, 7) = "●" .Cells(i + 1, 7) = "★" End If Next i 'Y列（"sheet2"のG列）の最後尾列(Q列)への移動 .Columns(7).Cut .Columns(17).Insert End With End Sub

  • VBA マクロ実行時エラー　1004

    すみません (1)Workbooks(p_addr_Name).Worksheets(sheet_check).Range(Cells(7, 2), Cells(19, 2)).Copy (2)Workbooks(p_SH_weekly).Worksheets("Sheet1").Range(Cells(7, i), Cells(19, i)).PasteSpecial Paste:=xlPasteAll その際(2)で「実行時エラー'1004'」が出ました、教えてください。 ＊上記引数は全部入りました 宜しくお願いします

  • エクセルvbaでのセルの情報を貼り付け方法

    vba初心者です。sheet1にあるセルの情報をsheet2にあるセルに貼り付けようと考えています。 下記のようにプログラムしました。 If Cells(Line, 6).Value = "" Then Cells(Line, 6).Value = "データがありません" Cells(Line, 5).Value GoTo コピー貼り付け End If コピー貼り付け: Cells(Line, 5).Copy 'コピーする Worksheets("輸入Parts").Range("A2").PasteSpecial Paste:=xlPasteValues '値を貼り付け 問題はコーピー貼り付けの箇所でRange("A2")ではなくA列の最初の空白のセルに貼り付けるようにしたいです。 どなたかお力をお貸しください。

  • VBAの操作

    ↓の事を行いていのでうまくいきません。 アドバイスをお願いできませんか? 変更前(Sheet1); (A列) (B列) 1 ABC010 Data_010 2 ABC020 (同上) 'B1-B2は結合セル 3 ABC030 Data_020 4 ABC040 (同上) 'B3-B4は結合セル . . 変更後(Sheet2); (A列) (B列) 1 ABC010 "OK" 2 ABC020 "OK" 3 Data_010 "Comp" '追加行 4 ABC030 "OK" 5 ABC040 "OK" 6 Data_020 "Comp" '追加行 . . Sheet1(B列)に値があれば、 Sheet2(A列)に結合セルの単位で値をコピーする。 Sheet2(B列)には"OK"コメント その都度、必ず最後に行追加して結合セルの値、"Comp"コメントをコピーする. 現象は毎行、追加行が挿入されてしまいます。 Sub testVBA() Dim i Worksheets("Sheet1").Range("A:B").Copy With Worksheets("Sheet2") .Range("A1").PasteSpecial For i = 1 To 1000 If .Cells(i, 2) <> "" Then .Cells(i + 1, 1) = .Cells(i, 2) .Cells(i + 1, 2) = "Comp" 　　.Cells(i, 2) = "OK" End If Next i End With End Sub

  • VBA：Offsetから値が貼付けれない

    はじめまして。 VBAを利用してマクロを作っているのですが、 Range("a6:l6").Copy Worksheets("結果シート").Range("A65536").End(xlUp).Offset(1) というのは動くのですが、結果シートへの貼付けを「値」で行いたいと思い、 以下の通りValueを指定しても動きません。 Range("a6:l6").Copy Worksheets("結果シート") .Range("A65536").End(xlUp).Offset(1).value PasteSpecialを使うと良いのかと思い、 Range("a6:l6").Copy Worksheets("結果シート") .Range("A65536").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues としてもエラーが出ます。 数式の結果を取得して、別のシートの空白セルを探し、「値」として張付ける。 というのがしたいのですが、なにか上手い方法があれば、ご教授お願いします。

  • このVBAの処理を速くしたいのですが…

    お世話になります data.xlsmとBook1-Book25.xlsxの 合計26ファイルを開いた状態で 以下のマクロを実行しています 私が使っているマシンでは 10分くらいかかるのですが この時間を短くすることは 出来ますでしょうか？ Sub copy() Application.ScreenUpdating = False Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1:D1048576").copy Workbooks("data.xlsm").Worksheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues Range("G1:K1048576").Clear Range("A1:E1048576").copy Range("G1:K1048576").PasteSpecial Paste:=xlPasteValues Range("I2").ClearContents Range("I1048576").End(xlUp).ClearContents Range("A2:D1048576").Clear Range("O1:Q1").copy Range("S1048576").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues あとは上記をBook2,Book3と変えてBook25まで同じ式を記入 End Sub

  • 簡単マクロ編集

    Sheets("Sheet1").Select　　←Range("A3:H8") Selection.Copy Sheets("Sheet2").Select Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Sheet4").Select Application.CutCopyMode = False ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True 下方にこの操作を繰り返ししたいのですが Dim i As Long Worksheets("Sheet1").Select For i = 3 To 100 Step 6 If Cells(i, "A") = "" Then Exit Sub End If Cells(i, "A").Resize(6, 8).Copy Destination:=Worksheets("Sheet2").Range("A3:H8") Next i 貼付けは値で貼り付けたいと思います。 どう組み合わせればよいですか？

  • VBA マクロ処理時間の短縮について

    下記のコードを作りましたが、マクロを実行すると砂時計マークが表示されて、処理が終了するまでに３０秒くらいかかります。 コードを変更して、マクロ処理時間を短縮する事はできないでしょうか？ Sub A列のコピー() Dim rw2 As Long Dim rw1 As Long Dim newdate As Date With Worksheets("sheet1") rw2 = .cells(.Rows.Count, "c").End(xlUp).Row newdate = .Range("c" & rw2).value For rw1 = rw2 - 1 To 1 Step -1 If .Range("c" & rw1).value <> newdate Then Exit For Next rw1 .Range(.cells(rw1 + 1, 1), .cells(rw2, 1)).Copy Worksheets("sheet2").Range("v6").PasteSpecial xlValue If rw1 + 26 <= rw2 Then .Range(.cells(rw1 + 26, 1), .cells(rw2, 1)).Copy Worksheets("sheet2").Range("v40").PasteSpecial xlValue Application.CutCopyMode = False End If Application.CutCopyMode = False End With End Sub 各セルは、６０００行くらいまで表示されています。 　よろしくお願いします。

  • 印刷後のVBAの実行　(3)

    Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("Sheet1").Range("D5") = "不要" Then GoTo P1 ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub sheet1のD5に「不要」と入っていたら 24～33行目の作業がキャンセルになりますが sheet2のD5にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか？ ご回答お願いします

  • Excel VBA 指定シートの取込

    こんにちは。 ExcelのVBAを使用して、異なるBookのシートを取込みたいのですが、 シートが無かった場合の処理方法がわかりません。 現在のコードは下記の様になっております。 With Workbooks.Open"BOOK1.xls" .Worksheets("Sh1").Cells.Copy ThisWorkbook.Sheets("Sheet1").Range("A1") .Worksheets("Sh2").Cells.Copy ThisWorkbook.Sheets("Sheet2").Range("A1") .Worksheets("Sh3").Cells.Copy ThisWorkbook.Sheets("Sheet3").Range("A1") .Close End With Book1に指定したシートが無い場合、何もしないようにしたいのですが、 どの様に書き換えれば宜しいでしょうか？ よろしくお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する