Excelでwatabeさんに複数のセルを参照

質問

Excel2007でwatabe007さんに以前に作って頂いたこのようなソースがあります。
Sub Test4()
Dim LastO As Long, LastG As Long
Dim i As Long, str As String
Range("D3", Cells(Rows.Count, "F").End(xlUp)).ClearContents
LastO = Cells(Rows.Count, "O").End(xlUp).Row
Range("A3:C3").Value = Cells(LastO, "O").Resize(, 3).Value
str = Range("A3").Value & Range("B3").Value & Range("C3").Value
For i = 3 To LastO
　　If str = Cells(i, "O").Value & Cells(i, "P").Value & Cells(i, "Q").Value Then
　　　　LastG = Cells(Rows.Count, "D").End(xlUp).Row + 1
　　　　If LastG < 3 Then LastG = 3
　　　　Cells(LastG, "D").Resize(, 3).Value = Cells(i + 1, "O").Resize(, 3).Value
　　End If
Next
End Sub
これにいつも格子をつけて文字がセンターになるようにしたいですがどうすればよろしいですか？解答よろしくお願いいたします。

回答No.5

watabe007 · ベストアンサー

>22、23行目の
>　.Value = Cells(i + 1, "O").Resize(, 3).Value
>が黄色くなります。
Cells(LastG, "D").Resize(, 3).Value = Cells(i + 1, "O").Resize(, 3).Value
では問題なく
With Cells(LastG, "D").Resize(, 3)
　　・・・
　　.Value = Cells(i + 1, "O").Resize(, 3).Value
だとエラーが出るのですね
こちらでは原因がわからないので
Cells(LastG, "D").Resize(, 3).Value = Cells(i + 1, "O").Resize(, 3).Value
に戻しましょう
>3行目のclearcontentsをclearに書き換えても良かったのでしょうか？
>これにいつも格子をつけて文字がセンター今回、D、E、F列を色付け、
以上の要望により色付け、罫線の格子をを行いましたが
ClearContentsでは値しか初期化できないのでClearで処理しております。
Sub Test4その4()
　Dim LastO As Long, LastG As Long
　Dim i As Long, str As String
　Range("D3", Cells(Rows.Count, "F").End(xlUp)).Clear
　LastO = Cells(Rows.Count, "O").End(xlUp).Row
　Range("O3:Q" & LastO).Interior.Color = xlNone
　Range("A3:C3").Value = Cells(LastO, "O").Resize(, 3).Value
　str = Range("A3").Value & Range("B3").Value & Range("C3").Value
　For i = 3 To LastO - 1
　　If str = Cells(i, "O").Value & Cells(i, "P").Value & Cells(i, "Q").Value Then
　　　LastG = Cells(Rows.Count, "D").End(xlUp).Row + 1
　　　If LastG < 3 Then LastG = 3
　　　'D、E、F列の色付け(不要なら省いてください。)
　　　Cells(LastG, "D").Resize(, 3).Interior.Color = vbYellow
　　　'D、E、F列の色付け(不要なら省いてください。)
　　　Cells(LastG, "D").Resize(, 3).Value = Cells(i + 1, "O").Resize(, 3).Value
　　　'D、E、F列の格子(不要なら省いてください。)
　　　Cells(LastG, "D").Resize(, 3).Borders.LineStyle = xlContinuous
　　　'D、E、F列のいろづけ文字を中央に(不要なら省いてください。)
　　　Cells(LastG, "D").Resize(, 3).HorizontalAlignment = xlCenter
　　　'O、P、Q列で見つかった文字を色付け(不要なら省いてください。)
　　　Cells(i + 1, "O").Resize(, 3).Interior.Color = vbYellow
　　End If
　Next
End Sub

お礼

watabe007さん。ありがとうございました。まだまだ身に着いてないせいか、久しぶりにパソコン触ると今までできたことが忘れてきて大変です。たすかりました。経験の無い者が作ったことのない物を作るって本当に大変ですね。感謝、感謝します！まだまだ質問しますんでご助力お願いします。

回答No.4

watabe007

Sub Test4その3()
　Dim LastO As Long, LastG As Long
　Dim i As Long, str As String
　Range("D3", Cells(Rows.Count, "F").End(xlUp)).Clear
　LastO = Cells(Rows.Count, "O").End(xlUp).Row
　Range("O3:Q" & LastO).Interior.Color = xlNone
　Range("A3:C3").Value = Cells(LastO, "O").Resize(, 3).Value
　str = Range("A3").Value & Range("B3").Value & Range("C3").Value
　For i = 3 To LastO - 1
　　If str = Cells(i, "O").Value & Cells(i, "P").Value & Cells(i, "Q").Value Then
　　　LastG = Cells(Rows.Count, "D").End(xlUp).Row + 1
　　　If LastG < 3 Then LastG = 3
　　　With Cells(LastG, "D").Resize(, 3)
　　　　.Interior.Color = vbYellow
　　　　.Value = Cells(i + 1, "O").Resize(, 3).Value
　　　　.Borders.LineStyle = xlContinuous
　　　　.HorizontalAlignment = xlCenter
　　　End With
　　　Cells(i + 1, "O").Resize(, 3).Interior.Color = vbYellow
　　End If
　Next
End Sub

お礼

こんにちはwatabe007さん。引き続きでなんですが、やはり上手くいきません。
22、23行目の
　.Value = Cells(i + 1, "O").Resize(, 3).Value
が黄色くなります。

3行目のclearcontentsをclearに書き換えても良かったのでしょうか？

補足

実行時エラー424
オブジェクトが必要です。

となります。

回答No.3

watabe007

>Cells(i + 1, "O").Resize(, 3).Interior.Color = vbYellow
>の部分を質問にから抜けてましたΣ(||゜Д゜)ヒィィィィ
>すみません。これも入れた型でお願いします。
8行目、下記のように変更しました
For i = 3 To LastO　⇒　For i = 3 To LastO - 1
13行目に下記を追加しました。
　.Interior.Color = vbYellow

Sub Test4その2()
　Dim LastO As Long, LastG As Long
　Dim i As Long, str As String　
　Range("D3", Cells(Rows.Count, "F").End(xlUp)).ClearContents
　LastO = Cells(Rows.Count, "O").End(xlUp).Row
　Range("A3:C3").Value = Cells(LastO, "O").Resize(, 3).Value
　str = Range("A3").Value & Range("B3").Value & Range("C3").Value
　For i = 3 To LastO - 1
　　If str = Cells(i, "O").Value & Cells(i, "P").Value & Cells(i, "Q").Value Then
　　　LastG = Cells(Rows.Count, "D").End(xlUp).Row + 1
　　　If LastG < 3 Then LastG = 3
　　　With Cells(LastG, "D").Resize(, 3)
　　　　.Interior.Color = vbYellow
　　　　.Value = Cells(i + 1, "O").Resize(, 3).Value
　　　　.Borders.LineStyle = xlContinuous
　　　　.HorizontalAlignment = xlCenter
　　　End With
　　End If
　Next
End Sub

お礼

watabe007さん！何回もすみません！この下のソースで作ってもらえませんでしょうか？

Sub Test4()
Dim LastO As Long, LastG As Long
Dim i As Long, str As String
Range("D3", Cells(Rows.Count, "F").End(xlUp)).ClearContents
LastO = Cells(Rows.Count, "O").End(xlUp).Row
Range("O3:Q" & lastO).Interior.Color = xlNone
Range("A3:C3").Value = Cells(LastO, "O").Resize(, 3).Value
str = Range("A3").Value & Range("B3").Value & Range("C3").Value
For i = 3 To LastO
　　If str = Cells(i, "O").Value & Cells(i, "P").Value & Cells(i, "Q").Value Then
　　　　LastG = Cells(Rows.Count, "D").End(xlUp).Row + 1
　　　　If LastG < 3 Then LastG = 3
　　　　Cells(LastG, "D").Resize(, 3).Value = Cells(i + 1, "O").Resize(, 3).Value
Cells(i + 1, "O").Resize(, 3).Interior.Color = vbYellow
　　End If
Next
End Sub
お願いいたします(>_<。)

補足

すみません。質問が説明不足でした。検索結果で値が出来上がる度に、それらを真ん中に持っていったり、格子で囲われることが希望でした。
久しぶりだったので質問能力まで衰えてしまいます。

回答No.2

watabe007

>ですが残念ながらですがエラーがでてしまいます。なぜですかね？
961awaawa さんが今回UPされた
Sub Test4()
　　Dim LastO As Long, LastG As Long
・・・・
・・・・
End Sub
は、エラーは出ないのですか？
下から4行目の
Cells(LastG, "D").Resize(, 3).Value = Cells(i + 1, "O").Resize(, 3).Value
が
　　With Cells(LastG, "D").Resize(, 3)
　　　　.Value = Cells(i + 1, "O").Resize(, 3).Value
　　　　.Borders.LineStyle = xlContinuous
　　　　.HorizontalAlignment = xlCenter
　　End With
に変わっただけですよ。
こちらでのテストもエラーは出なかったです。

お礼

Sub Test4その1()
　Dim LastO As Long, LastG As Long
　Dim i As Long, str As String
　Range("D3", Cells(Rows.Count, "F").End(xlUp)).ClearContents
　LastO = Cells(Rows.Count, "O").End(xlUp).Row
　Range("A3:C3").Value = Cells(LastO, "O").Resize(, 3).Value
　str = Range("A3").Value & Range("B3").Value & Range("C3").Value
　For i = 3 To LastO
　　If str = Cells(i, "O").Value & Cells(i, "P").Value & Cells(i, "Q").Value Then
　　　LastG = Cells(Rows.Count, "D").End(xlUp).Row + 1
　　　If LastG < 3 Then LastG = 3
　　　With Cells(LastG, "D").Resize(, 3)
　　　　.Value = Cells(i + 1, "O").Resize(, 3).Value
Cells(i + 1, "O").Resize(, 3).Interior.Color = vbYellow

　　　　.Borders.LineStyle = xlContinuous
　　　　.HorizontalAlignment = xlCenter
　　　End With
　　End If
　Next
End Sub

watabe007さん。これであってますかね?
Cells(i + 1, "O").Resize(, 3).Interior.Color = vbYellow
の部分を質問にから抜けてましたΣ(||゜Д゜)ヒィィィィ
すみません。これも入れた型でお願いします。

回答No.1

watabe007

こんばんは
https://okwave.jp/qa/q9534703.html
こちらのSub Test4()ですね
>これにいつも格子をつけて文字がセンターになるようにしたい
対象はD、E、F列で良いですか
Sub Test4その1()
　Dim LastO As Long, LastG As Long
　Dim i As Long, str As String
　Range("D3", Cells(Rows.Count, "F").End(xlUp)).ClearContents
　LastO = Cells(Rows.Count, "O").End(xlUp).Row
　Range("A3:C3").Value = Cells(LastO, "O").Resize(, 3).Value
　str = Range("A3").Value & Range("B3").Value & Range("C3").Value
　For i = 3 To LastO
　　If str = Cells(i, "O").Value & Cells(i, "P").Value & Cells(i, "Q").Value Then
　　　LastG = Cells(Rows.Count, "D").End(xlUp).Row + 1
　　　If LastG < 3 Then LastG = 3
　　　With Cells(LastG, "D").Resize(, 3)
　　　　.Value = Cells(i + 1, "O").Resize(, 3).Value
　　　　.Borders.LineStyle = xlContinuous
　　　　.HorizontalAlignment = xlCenter
　　　End With
　　End If
　Next
End Sub

お礼

こんにちは。お久しぶりですwatabe007さん。いつもありがとうございます。
変えたり付け加えたりするのは下記の部分だけですか？
withをたした
With Cells(LastG, "D").Resize(, 3)
と
　.Borders.LineStyle = xlContinuous
　　　　.HorizontalAlignment = xlCenter
　　　End Withを追加しました。
ですが残念ながらですがエラーがでてしまいます。なぜですかね？

補足

Sub Test4その1()
　Dim LastO As Long, LastG As Long
　Dim i As Long, str As String
　Range("D3", Cells(Rows.Count, "F").End(xlUp)).ClearContents
　LastO = Cells(Rows.Count, "O").End(xlUp).Row
　Range("A3:C3").Value = Cells(LastO, "O").Resize(, 3).Value
　str = Range("A3").Value & Range("B3").Value & Range("C3").Value
　For i = 3 To LastO
　　If str = Cells(i, "O").Value & Cells(i, "P").Value & Cells(i, "Q").Value Then
　　　LastG = Cells(Rows.Count, "D").End(xlUp).Row + 1
　　　If LastG < 3 Then LastG = 3
　　　With Cells(LastG, "D").Resize(, 3)
　　　　.Value = Cells(i + 1, "O").Resize(, 3).Value
Cells(i + 1, "O").Resize(, 3).Interior.Color = vbYellow

　　　　.Borders.LineStyle = xlContinuous
　　　　.HorizontalAlignment = xlCenter
　　　End With
　　End If
　Next
End Sub

watabe007さん。これであってますかね?