• 締切済み

エクセル マクロ 範囲指定。

先日、OKWAVEのサイトでエクセルマクロの質問をさせていただき 下記の回答を活用したいのでしが myKey = Worksheets("Sheet2").Range("A1").ValueをA1A2・・・A50のように 50個を一度に処理したいのですがどのように変更すればよろしいのでしようか 自分なりに調べてみましたが知識がなくできませんでした ご回答のいただいたmitarashiさんにお聞きしたいのですがお聞きする手段がわからず 再度、質問させていただきます。                       宜しくお願いいたします。 Sub test() Dim targetRange As Range Dim buf As Variant Dim i As Long, j As Long, myColorIndex As Long Dim myKey As Variant Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set targetRange = Worksheets("Sheet1").Range("J10:BB10000") buf = targetRange myColorIndex = 4 myKey = Worksheets("Sheet2").Range("A1").Value With targetRange For i = 1 To UBound(buf, 1) For j = 1 To UBound(buf, 2) If buf(i, j) = myKey Then .Cells(i, j).Interior.ColorIndex = myColorIndex Next j Next i End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

みんなの回答

  • mitarashi
  • ベストアンサー率59% (574/965)
回答No.4

n-junさんのCountIf案面白そうなので試してみましたが、残念ながら3重ループに比べてかなり遅かったです。 #1,2同様、ただし、Worksheets("Sheet2").Range("A1:A100")も配列に入れてループを回すと、15秒前後でしたが、CountIFだと、十数倍かかりました。(xl2010,大昔のシングルコアCeleron2.4GHz) ただ、http://okwave.jp/qa/q7234627.htmlで、中途半端な回答にとどめたのは理由があります。 処理が10数秒で終わっても、だだっ広いシートを眺めていると、直ぐに数分経ってしまいそうなので、本当にやりたいのは何なのか、どんなOutputが欲しいのか補足をお待ちしていたものです。 さすがに、回答してから数日空くと、リアクションは無いものと見切りをつけてしまいますので、補足は早めにお願いいたします。

fukuzawakamon
質問者

お礼

mitarashiさん ご回答ありがとうございます。 補足等が遅くなり申し訳ありませんでした。 私の質問させていただく準備が整ってから再度、質問させていただきます。 たいへん申し訳ありませんでした。

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.3

検証していないけど、 COUNTIF関数とか使えばいいのでは? Sub test() Dim targetRange As Range Dim buf As Variant Dim i As Long, j As Long, myColorIndex As Long 'Dim myKey As Variant Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set targetRange = Worksheets("Sheet1").Range("J10:BB10000") buf = targetRange myColorIndex = 4 'myKey = Worksheets("Sheet2").Range("A1").Value With targetRange For i = 1 To UBound(buf, 1) For j = 1 To UBound(buf, 2) If WorksheetFunction.CountIf(Worksheets("Sheet2").Range("A1:A50"), buf(i, j)) > 0 Then .Cells(i, j).Interior.ColorIndex = myColorIndex Next j Next i End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

fukuzawakamon
質問者

お礼

ご回答ありがとうございます 実行してみましたが途中でパソコンが固まって動かない状態になりました。 他に原因があると思いますので再度、実行してみます。

  • DreamyCat
  • ベストアンサー率56% (295/524)
回答No.2

for j=1 to 50 myKey = Worksheets("Sheet2").Range("A" & j).Value とか myKey = Worksheets("Sheet2").cells(j,1).Value のようにしてください。 rangeとcellsでは行と列を記述する順番が逆なので気をつけてください。

fukuzawakamon
質問者

お礼

ご回答ありがとうございます。

  • yucco_chan
  • ベストアンサー率48% (828/1705)
回答No.1

Sub test() Dim targetRange As Range Dim buf As Variant Dim i As Long, j As Long, myColorIndex As Long Dim myKey As Variant '---追加 dim k as long '---追加終わり Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set targetRange = Worksheets("Sheet1").Range("J10:BB10000") buf = targetRange myColorIndex = 4 '---追加 for k=1 to 100 '1はSheet2のA1の1、100は、A100の100の意。適宜修正してください '---修正 myKey = Worksheets("Sheet2").Range("A" & k).Value 'myKey = Worksheets("Sheet2").Range("A1").Value '----追加修正終わり With targetRange For i = 1 To UBound(buf, 1) For j = 1 To UBound(buf, 2) If buf(i, j) = myKey Then .Cells(i, j).Interior.ColorIndex = myColorIndex Next j Next i End With '---追加 next k '---追加終わり Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

fukuzawakamon
質問者

お礼

ご回答ありがとうございます。 申し訳ありません 途中で固まってしまいます 別の原因を解決してから再度、実行してみます。

関連するQ&A