- ベストアンサー
EXCEL VBAで特定のセルの値による判定について
すいません、EXCEL VBAで質問があります。 A1~A9 空欄 A10 "赤" A11~A16 空欄 A17 "青" A18~A21 空欄 A22 "青" A23~A35 空欄 A36 "赤" ・・・ A列の1000行までの間にランダムに赤か青の値が入っています。 A列の空欄のセルについて、下のセルを見ていき、 最初に来る値が赤であれば、それまでの空欄に"りんご"、青であれば"みかん"という値を入れる処理をVBAでやるにはどうしたらいいのでしょうか。 上の例でいうと、A1~A9及びA23~A35のセルには"りんご"、A11~A16及びA18~A21のセルには"みかん"と入ります。 do until~loopやfor~nextでやろうとしましたがどうにもうまくいきません。 よろしくお願いいたします。
- takohasisa
- お礼率74% (63/85)
- オフィス系ソフト
- 回答数4
- ありがとう数2
- みんなの回答 (4)
- 専門家の回答
質問者が選んだベストアンサー
一例です。 SpecialCells と Areas を使ってみました。 Sub test1() Dim i As Long With Range("A1:A1000").SpecialCells(xlCellTypeBlanks) For i = 1 To .Areas.Count If .Areas(i)(.Areas(i).Rows.Count + 1).Value = "赤" Then .Areas(i).Value = "りんご" ElseIf .Areas(i)(.Areas(i).Rows.Count + 1).Value = "青" Then .Areas(i).Value = "みかん" End If Next i End With End Sub
その他の回答 (3)
- onlyrom
- ベストアンサー率59% (228/384)
>do until~loopやfor~nextでやろうとしましたがどうにもうまくいきません。 質問するときはその上手くいかないコードをアップしましょう。 それを修正加筆すれば質問者自身が考えたコードが完成することになりますので。 今回のことをFor Nextでやる場合は、 A1からではなく最終セル(例えば、A1000)から処理するのがコツです。 '------サンプル 1 --------------------- Sub Test333() Dim myValue Dim R As Long Dim LastRow As Long LastRow = Cells(Rows.Count, "A").End(xlUp).Row For R = LastRow To 1 Step -1 If Cells(R, "A").Value = "赤" Then myValue = "りんご" ElseIf Cells(R, "A").Value = "青" Then myValue = "みかん" Else Cells(R, "A").Value = myValue End If Next R End Sub '------サンプル 2 -------------------- Sub Test555() Dim myValue Dim R As Long Dim LastRow As Long LastRow = Cells(Rows.Count, "A").End(xlUp).Row For R = LastRow To 1 Step -1 Select Case Cells(R, "A").Value Case "赤" myValue = "りんご" Case "青" myValue = "みかん" Case Else Cells(R, "A").Value = myValue End Select Next R End Sub '---------------------------------------------- 以上。
お礼
ありがとうございました。出来ました。 今後は作りかけのコードでもアップするようにします。
- n-jun
- ベストアンサー率33% (959/2873)
Sub try() Dim r As Range For Each r In Range("A:A").SpecialCells(xlCellTypeBlanks).Areas r.Value = IIf(r.Resize(1).Offset(r.Cells.Count).Value = "赤", "りんご", "みかん") Next End Sub ご参考になれば。(エラー処理ないですけど)
- hige_082
- ベストアンサー率50% (379/747)
下から上へ処理してみました Sub test() Dim i As Long Dim a As String a = "" For i = Range("a65536").End(xlUp).Row To 1 Step -1 If Cells(i, 1).Value = "" Then Cells(i, 1).Value = a Else Select Case Cells(i, 1).Value Case "赤" a = "りんご" Case "青" a = "みかん" Case Else a = "" End Select End If Next i End Sub 以上です
関連するQ&A
- エクセルVBA 条件にあうときセルを塗りつぶすには?
エクセルVBA 条件にあうときセルを塗りつぶすには? エクセルVBAについて教えてください。 _________A 列 _________B 列_________C列_________D列 -------------------------------------------- 1行| 基準値_________ 5_____________1____________8 2行| りんご____________1_____________9____________0 3行| みかん___________12___________5____________3 4行| ぶどう____________15___________7____________8 5行| バナナ____________3_____________1____________4 上図のようにデータがあります。 (実物は列行共に膨大です。また条件を4つ以上つける予定なので条件付書式は使えません) 各列の基準値に対して、セルの増減が、0以下のときに黄色に、5から8のとき大きくなるときに赤、9以上のときに青にセルの色を塗りつぶしたいです。 どのようにすればよいでしょうか? B列の場合、基準値が5です。 B2のセルの場合、基準値5と1(B2セル)の増減は-4です。 増減が0以下のときは黄色に、増減が5から8のときは赤に、増減が9以上のときに青にするので、このときは黄色に塗りつぶします。 B3のセルの場合、基準値5と12(B3セル)の増減は7です。 増減が5から8のとき赤に塗りつぶすので、このセルは赤に塗りつぶします。 B4のセルの場合、基準値5と15(B4セル)の増減は10です。 増減が9以上のとき青色に塗りつぶすので、このセルは青色に塗りつぶします。 C2のセルの場合は、C列の基準値は1(C1セル)です。 基準値1と9(C2のセル)の増減は8です。 増減が5から8のとき赤に塗りつぶすので、このセルは赤に塗りつぶします。 よろしくお願いいたします。
- ベストアンサー
- Visual Basic
- EXCEL VBA における個数のカウント方法について
すいませんEXCEL VBAについて質問があります。 A列 1行 みかん 2行 みかん 3行 (空欄) 4行 みかん 5行 ぶどう 6行 みかん 7行 みかん 8行 ぶどう 9行 (空欄) ・ ・ 50行 A列は「みかん」若しくは「ぶどう」の値又は空欄のいずれかになっている。 空欄は無視して(1行~4行はみかんが3つ連続で並んだと考える)、 50 行までの間に「みかん」が最大で何回連続で並んだかを調べ、その最大の値をB1セルに入れる。 これをVBAで処理するにはどうしたらいいのでしょうか。 For ~NextとIfで条件分岐 というような形になるのかなと思ったのですが どうしても思い浮かびません。 どうぞよろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセル VBA
エクセル VBA 指定セルがNULLじゃない場合、セルを横に1つずつずらしていきNULLのセルで抜けるVBを作りたいです。 Do Until IsNull???? loop
- ベストアンサー
- Visual Basic
- 【VBA】セルに含まれない値を追加していく
VBA初心者です あるリストの、指定の列の重複しない値のリストを作成したいのですが 具体的には A B C 1 大阪 りんご 10 2 東京 りんご 20 3 東京 りんご 30 4 名古屋 ごりら 40 5 福岡 ごりら 50 6 大阪 らっぱ 60 指定のセル内(E1:E10)にA列の重複しないリスト (この例だと、大阪、東京、名古屋、福岡) を作成したいのです いくつか試してみたけれどうまくいきません どのようなVBAを作成すればよいでしょうか よろしくお願いいたします
- ベストアンサー
- その他MS Office製品
- VBAで連続した複数セルの値の調べかた
エクセルVBAでA1セルからF1セルまでの6せるのそれぞれの値を1つの値として取得できる方法はありませんか? LOOP処理とかで1セルごと処理して取得するとかでなく 関数とかRANGE(”A1:F1”)のプロパティとかで何か無いでしょうか 宜しくお願いします。
- 締切済み
- その他(プログラミング・開発)
- vba doloopで=>が機能しません
vbaでa1:a4にランダムで◯を入れて、a5で◯の数を数えます。 その時a5の数が3以上になるまでランダムで入れ、3以上ならb1:b4にランダムで◯を入れて、b5が3以上なら、c1:c4、、、をAd(30回)までしたいのですが、◯の数が3以上じゃなくても隣のセルに行って処理を初めてしまいます。 どうしたら3以上になるまでをすることができますか? 今は dim i as long for i=1 to 30 do until range("a5")=>3 ランダムに入れる処理 loop next i でやってます。 fornext 使わずに1つずつコードを作ればできるのですが、直す時大変だし、重くなるので、、
- 締切済み
- Excel(エクセル)
- EXCEL VBA (変更セル値の値をとる)
「A1セルからJ1セル」にランダムに数字が入っていたとします。 A1セルからH1セルのどこかの数字を変更した場合、その数字が変更したセルからJ1セルまで同じ数字になるようにしたいです。 たとえば、A1からJ1セルに1~10の数字をいれ、B1セル値の2を5に変更した場合、B1セルからJ1セルまでの値が全て5になるようにしたいです。 これはVBAで可能ですか? すいませんが宜しくお願いします。
- ベストアンサー
- Windows XP
- エクセルVBA
1ブック A列 B列 みかん 105 りんご 150 バナナ 198 2ブック A列 D列 みかん 105 りんご 150 バナナ 198 2ブックのA列が1ブックのA列と同じ値なら1ブックのB列の値を2ブックのD列に反映させたいのですが、どうしたら良いでしょうか。 A列の値を基準にB列だけでなく、他列も抽出したいのですが…。 宜しくお願いします。
- ベストアンサー
- Excel(エクセル)
- 【VB】セルが空になるまで処理を繰り返したい
Excel VBAを使用してです。 列Aにデータがずらっと入っています。 そのデータを列Bに、 Do while ~loop か Do until ~loopを使って データが無くなるまでコピーするという処理を書きたいのです。 VB歴が浅いためひらめきません。よろしくお願いします。m(__)m
- ベストアンサー
- Visual Basic
- エクセルVBAについて質問です。初心者です。
エクセルVBAについて質問です。初心者です。 ユーザーフォームにリストボックスとコマンドボタンを1つずつ配置しています。 A列 B列 りんご 1 みかん 2 (りんご、みかん、1、2を太い罫線で四角に囲んでいます) リストボックスには「りんご」と「みかん」が入っていて、りんごを選びコマンドボタンを押すと、「りんご」と「1」のセルが消去され、上方向にセルをずらすようにしています。 「みかん」を選びコマンドボタンを押すと「みかん」と「2」のセルが消えるのですが、そのとき「みかん」と「2」のセルの下段に引いている罫線まで消えてしまうのです。これを阻止する方法を教えていただけないでしょうか。 以下はコードです。 Private Sub CommandButton1_Click() Range("A1").Offset(ListBox1.ListIndex).Delete Shift:=xlUp Range("A1").Offset(ListBox1.ListIndex, 1).Delete Shift:=xlUp Unload UserForm1 End Sub おそらくこれに 「もし消去対象のセルが最終行のセルであれば With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlMedium End With これを行いなさい」という感じのコードを作ればいいと思うのですが、『もし消去対象のセルが最終行のセルであれば』の部分がうまく作れません…。 なおA列、B列の文字・値はどんどん増えていく可能性があるので最終行を使っています。 よろしくお願いします。
- ベストアンサー
- Visual Basic
お礼
ありがとうございました。SpecialCellsの使い方がよくわからなかったのですが、教えていただいたコードで勉強しました。 またよろしくお願いいたします。