- 締切済み
【VBA】特定の範囲で同じ値を含むセルの色を変える
Excelのマクロに関して質問です。 特定の範囲(複数行と複数列)内で重複した値（セル内の最初の4文字が同じもの）を含むセルに色をたいです。 さらに、重複した値ごとに色分けをしたいです。例えば重複した値[1111]と重複した値[1112]の時では、前者が赤色で後者は青色、更に他の重複する値はまた他の色でというように、 要どのセルとセルが重複しているか色分けをして一目瞭然にしたいです。 ※なお特定の範囲は以下の変数を利用します。 dataRow = Workbooks(booksName).Worksheets(sheetsName).Range("A2").End(xlDown).Row 'データの入っている最終行を取得 dataColum = Workbooks(booksName).Worksheets(sheetsName).Range("A1").End(xlToRight).Column 'データの入っている最終列を取得 どなたか知恵をお貸し下さい。よろしくお願いします。
- yuki_tigers
- お礼率55% (31/56)
- Visual Basic
- 回答数1
- ありがとう数0
- みんなの回答 （1）
- 専門家の回答
みんなの回答
- jin34
- ベストアンサー率80% (17/21)
関連するQ&A
- 【VBA】特定の範囲で同じ値を含むセルの色を変える
Excelのマクロに関して質問です。 特定の範囲(複数行と複数列)内で重複した値（セル内の最初の4文字が同じもの）を含むセルの色を変えたいです。 さらに、重複した値ごとに色分けをしたいです。例えば重複した値[1111]と重複した値[1112]の時では、前者が赤色で後者は青色、更に他の重複する値はまた別の色でというように、 要は、どのセルとセルが重複しているか色分けをして一目瞭然にしたいです。 ※なお特定の範囲は以下の変数を利用します。 dataRow = Workbooks(booksName).Worksheets(sheetsName).Range("A2").End(xlDown).Row 'データの入っている最終行を取得 dataColum = Workbooks(booksName).Worksheets(sheetsName).Range("A1").End(xlToRight).Column 'データの入っている最終列を取得 どなたか知恵をお貸し下さい。よろしくお願いします。
- ベストアンサー
- Visual Basic
- 【VBA】特定の範囲で同じ値を含むセルの色を変える
Excelのマクロに関して質問です。 特定の範囲(複数行と複数列)内で重複した値（セル内の最初の4文字が同じもの）を含むセルの色を変えたいです。 さらに、重複した値ごとに色分けをしたいです。例えば重複した値[1111]と重複した値[1112]の時では、前者が赤色で後者は青色、更に他の重複する値はまた別の色でというように、 要は、どのセルとセルが重複しているか色分けをして一目瞭然にしたいです。 ※なお特定の範囲は以下の変数を利用します。 dataRow = Workbooks(booksName).Worksheets(sheetsName).Range("A2").End(xlDown).Row 'データの入っている最終行を取得 dataColum = Workbooks(booksName).Worksheets(sheetsName).Range("A1").End(xlToRight).Column 'データの入っている最終列を取得 どなたか知恵をお貸し下さい。よろしくお願いします。.
- ベストアンサー
- その他MS Office製品
- マクロセルの値によってセルの色を消す
エクセル2013です。 セルの値が0又は空白の場合でそのセルが色塗りされていたら色を消す というマクロをを作成しました。 ただ700行55列では処理が遅いです。 Sub 色消() '成功 Dim 最終行 Dim 最終列 Dim 対象セル As Range 最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得 最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得 For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) If 対象セル.Value = 0 Or 対象セル = "" Then 対象セル.Interior.ColorIndex = 0 End If Next 対象セル End Sub 対象範囲から対象セルを全部見つけて一括処理すれば早いのではと 以下のマクロを作成してみましたが Set 対象範囲 = Cells.Find(What:=0 Or "", LookIn:=xlValues, LookAt:=xlWhole) で構文ERRです。 どこを直せばいいのでしょうか？ よろしくお願いします。 Sub 色消2() '2014/8/4 '失敗 Dim 対象範囲 Dim 最終行 Dim 最終列 最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得 最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得 対象範囲 = Range(Cells(10, 17), Cells(最終行, 最終列)) Set 対象範囲 = Cells.Find(What:=0 Or "", LookIn:=xlValues, LookAt:=xlWhole) If Not 対象範囲 Is Nothing Then 対象範囲.Interior.ColorIndex = 0 End If End Sub
- ベストアンサー
- Excel（エクセル）
- マクロ EXCELの範囲をコピーして貼付け
『End(xlDown).Row』で取得した値を使ってセルの範囲指定＆コピーを行い、 新しく追加したシートに貼り付けたいのですがうまくいきません。 Sub attendanceJoin() Dim MaxRow As Integer 'シートの最終行の値 Workbooks("test.xls").Activate Dim NewWorkSheet As Worksheet Set NewWorkSheet = Worksheets.Add() '新しいシートを追加する MaxRow = Worksheets(2).Range("M1").End(xlDown).Row 'A列の最終行を取得 NewWorkSheet.Name = "統合" '新しく追加したシートの名前を変更 With Workbooks("test.xls") .Worksheets(2).Range("A1:M&MaxRow").Copy 'コピーするセルの範囲を指定 '↑ここでエラー。.Worksheets(2).Range("A1:M38").Copy を指定するイメージです。 .Worksheets("統合").Range("A1").PasteSpecial End With End Sub どなたか間違っている箇所のご教示お願い出来ますでしょうか。 どうぞよろしくお願い致します。
- ベストアンサー
- その他MS Office製品
- VBA 11行おきにセルの値を1づつ増やす
セルの値を最終行まで、11行おきに1増やしていく方法をお教えください。 現在1800行あります。 下記の構文を延々と続けるのは、気が遠くなります。 何卒よろしくお願いします。 Private Sub CommandButton1_Click() With Worksheets("○○○”） .Range("A1").Value = "1" .Range("A12").Value = .Range("A1").Value + 1 .Range("A23").Value = .Range("A12").Value + 1 .Range("A34").Value = .Range("A23").Value + 1 .Range("A45").Value = .Range("A34").Value + 1 ・・・・・・・ ・・・・・・・・ End With End Sub
- ベストアンサー
- Excel（エクセル）
- VBA初心者です。値を貼り付け について質問です。
ＶＢＡ初心者です。 値を貼り付け について教えてください。 Sub test() With Workbooks("A.xls").Worksheets("sheet1") .Range("A1").Copy Workbooks("Bxls").Worksheets("sheet1").Range("B2") .Range("A2").Copy Workbooks("B.xls").Worksheets("sheet1").Range("B4") End With End Sub コピーする方に計算式が入っているので 値を貼り付け したいのですが、どうすればいいのでしょうか？ PasteSpecial Paste:=xlPasteValues を使ったらよいというところまではわかったのですが・・・。 教えてください！よろしくお願いします！
- 締切済み
- Visual Basic
- コピー後に値のみ貼り付け エクセル、VBAの記述について
マクロ初心者です。 エクセルで選択範囲を指定後コピーし、 自動的に別のシートの末尾に貼り付けられるようにしたのですが、 この内容のまま「貼り付け」を「値のみ貼り付け」に訂正する場合 どのように変更すればいいのか、教えてくださると嬉しいです。 宜しくお願いいたします。 Sub 選択範囲をコピー後、指定シートの末尾に貼り付け Worksheets("sheet1").Activate Range("b11:I17").Copy Workbooks("book2.xls").Worksheets("Sheet1").Activate 行 = Range("B1").CurrentRegion.Rows.Count + 1 ActiveSheet.Paste _ Destination:=Workbooks("book2.xls").Worksheets("Sheet1").Range("B" & 行) End Sub
- ベストアンサー
- オフィス系ソフト
- データの値取得マクロ
Sub Macro1() ''Worksheets("Sheet1").Activate ' addrw = Range("b65536").End(xlUp).Offset(1).Row Cells(addrw, 2).PasteSpecial end sub でB列の最終行を取得しその後、最終行の次のセルから追加のデータを貼り付けるマクロを作成しました。 このあと、追加のデータを貼り付ける前のB列の最終行の値と貼り付け後のB列の最終行の値を取得したいのですがどうすればいいでしょうか？
- ベストアンサー
- オフィス系ソフト
- 【ＶＢＡ】「同じ文字を含むセルがあるならば」とやりたい
こんばんは。 エクセル2003を使用しています。 例えば A1→「りんご」 A2→「りんご食べたい」 の場合、 「りんご」は2個以上あります としたいのですがうまくいきません。 Sub 重複() For 行 = 1 To Cells(65536, 1).End(xlUp).Row If Cells.Find(what:=Range("a" & 行), LookAt:=xlPart) Is Nothing Then Else 'あるならば MsgBox Range("a" & 行) & "は2個以上あります" End If Next End Sub これだと取得セルもカウントされてしまうため、必ずMsgBoxが表示されてしまいます。 どうすれば取得セル意外にも取得セルを含むセルがあるかを調べられるのでしょうか？ そしてこれは A1→「りんご」 A2→「りんご食べたい」 A3→「みかん」 A4→「みかんはオレンジ」 A5→「バナナ」 ・ ・ ・ と続いており 最終的には →「りんご食べたい」 →「みかんはオレンジ」 →「バナナ」 にしたいのです。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- 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 としてもエラーが出ます。 数式の結果を取得して、別のシートの空白セルを探し、「値」として張付ける。 というのがしたいのですが、なにか上手い方法があれば、ご教授お願いします。
- ベストアンサー
- オフィス系ソフト
